home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TVDMX / TVDMX.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-20  |  83KB  |  3,296 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    tvDMX    --data editing project (ver 2.x)    }
  5. {                            }
  6. {    Copyright (c) 1992,93    Randolph Beck        }
  7. {                P.O. Box  56-0487    }
  8. {                Orlando, FL 32856    }
  9. {                CIS:  72361,753        }
  10. {                            }
  11. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  12.  
  13. Unit tvDMX;
  14.  
  15. {$B-,D+,O+,R-,V-,X+ }
  16.  
  17. interface
  18.  
  19. uses  Objects, Drivers, Views, Dialogs, App, RSet, DmxGizma;
  20.  
  21. var
  22.     DrawingRecNum  :  integer;
  23.  
  24. type
  25.     PDmxLink       = ^TDmxLink;
  26.     PDmxLabels       = ^TDmxLabels;
  27.     PDmxExtLabels  = ^TDmxExtLabels;
  28.     PDmxFLabels    = ^TDmxFLabels;
  29.     PDmxMLabels    = ^TDmxMLabels;
  30.     PDmxScroller   = ^TDmxScroller;
  31.     PDmxRecInd       = ^TDmxRecInd;
  32.     PDmxEditor       = ^TDmxEditor;
  33.  
  34.  
  35.     TDmxLink    =  OBJECT(TView)
  36.     Link    : PDmxScroller;
  37.       constructor Init(var Bounds: TRect);
  38.       constructor Load(var S: TStream);
  39.       function    GetPalette : PPalette;    VIRTUAL;
  40.       procedure Insert(AOwner: PGroup);
  41.       procedure Store(var S: TStream);
  42.       procedure SetState(AState: word;  Enable: boolean);  VIRTUAL;
  43.     end;
  44.  
  45.  
  46.     TDmxExtLabels  =  OBJECT(TDmxLink)
  47.     Len    : integer;
  48.     Data    : PCharArray;
  49.     Heaped    : boolean;
  50.     DblBar    : boolean;
  51.       constructor Init(ALen: integer; AData: PCharArray; var Bounds: TRect);
  52.       constructor InitInsert(AOwner: PGroup; ALen: integer; AData: PCharArray);
  53.       destructor  Done;  VIRTUAL;
  54.       constructor Load(var S: TStream);
  55.       procedure Store(var S: TStream);
  56.       procedure Draw;  VIRTUAL;
  57.       procedure DrawRuler(Upper, AtLimit: boolean);
  58.       procedure HandleEvent(var Event: TEvent);  VIRTUAL;
  59.       procedure SetState(AState: word;  Enable: boolean);  VIRTUAL;
  60.     end;
  61.  
  62.  
  63.     TDmxLabels    =  OBJECT(TDmxExtLabels)
  64.       constructor Init(DataStr: pstring; var Bounds: TRect);
  65.       constructor InitInsert(AOwner: PGroup;  DataStr: pstring);
  66.     end;
  67.  
  68.  
  69.     TDmxFLabels  =  OBJECT(TDmxExtLabels)
  70.       constructor Init(LabelStr: string;  var Bounds: TRect);
  71.       constructor InitInsert(AOwner: PGroup;  LabelStr: string);
  72.     end;
  73.  
  74.  
  75.     TDmxMLabels  =  OBJECT(TDmxExtLabels)
  76.       constructor Init(Labels: PSItem;  var Bounds: TRect);
  77.       constructor InitInsert(AOwner: PGroup;  Labels: PSItem);
  78.     end;
  79.  
  80.  
  81.     TDmxScroller =  OBJECT(TScroller)
  82.     Labels        : PDmxLink;
  83.     WorkingData    : pointer;
  84.     ActualRecordNum    : longint;
  85.     DataBlockSize    : longint;
  86.     BaseRecord    : longint;
  87.     CurrentRecord    : integer;
  88.     CurrentField    : pDMXfieldrec;
  89.     DMXfield1    : pDMXfieldrec;
  90.     LeftField    : pDMXfieldrec;
  91.     TotalFields    : integer;
  92.     RecordSize    : integer;
  93.     Locked        : boolean;
  94.     InitValid    : boolean;
  95.       constructor Init(ATemplate: string; var AData; BSize: longint;
  96.         var Bounds: TRect;  ALabels: PView;  AHScrollBar,AVScrollBar: PScrollBar);
  97.       procedure   InitStruct(var ATemplate );  VIRTUAL;
  98.       procedure   InitData(var AData );  VIRTUAL;
  99.       destructor  Done;  VIRTUAL;
  100.       constructor Load(var S: TStream);
  101.       procedure Store(var S: TStream);
  102.       procedure ChangeBounds(var Bounds: TRect);  VIRTUAL;
  103.       function    DataAt(RecNum: integer) : pointer;  VIRTUAL;
  104.       procedure DoneData;  VIRTUAL;
  105.       procedure DoneStruct;  VIRTUAL;
  106.       procedure Draw;  VIRTUAL;
  107.       procedure DrawRecord(Y: integer;  var DataRecord );
  108.       procedure FieldText(var S: string;  var Color: word;
  109.               Field: pDMXfieldrec;  var DataRec );  VIRTUAL;
  110.       procedure GetData(var Rec );  VIRTUAL;
  111.       function    GetPalette  : PPalette;  VIRTUAL;
  112.       procedure HandleEvent(var Event: TEvent);  VIRTUAL;
  113.       procedure LoadData(var S: TStream);  VIRTUAL;
  114.       procedure LoadStruct(var S: TStream);  VIRTUAL;
  115.       function    RecNumStr(RecNum: integer) : string;  VIRTUAL;
  116.       function    RecordLimit : longint;    VIRTUAL;
  117.       procedure ScrollDraw;  VIRTUAL;
  118.       procedure SetData(var Rec );  VIRTUAL;
  119.       procedure SetState(AState: word;  Enable: boolean);  VIRTUAL;
  120.       procedure StoreData(var S: TStream);  VIRTUAL;
  121.       procedure StoreStruct(var S: TStream);  VIRTUAL;
  122.       function    Valid(Command: word) : boolean;  VIRTUAL;
  123.       procedure WrongKeypressed(var Event: TEvent);  VIRTUAL;
  124.       private
  125.     InBuffer    : boolean;
  126.     DDelta,DSize    : TPoint;
  127.     FirstRow    : integer;
  128.     end;
  129.  
  130.  
  131.     TDmxRecInd     =  OBJECT(TDmxLink)
  132.       constructor Init(var Bounds: TRect;  Len: integer);
  133.       constructor InitInsert(AOwner: PGroup; Len: integer);
  134.       procedure Draw;  VIRTUAL;
  135.       procedure SetState(AState: word; Enable: boolean);  VIRTUAL;
  136.       procedure HandleEvent(var Event: TEvent);  VIRTUAL;
  137.     end;
  138.  
  139.  
  140.     TDmxEditor     =  OBJECT(TDmxScroller)
  141.     RecInd        : PDmxLink;
  142.     FieldData    : pointer;
  143.     RecordData    : pointer;
  144.     CurPos        : integer;
  145.     Vidis        : boolean;
  146.     DoubleValid    : boolean;
  147.     FirstKey    : boolean;
  148.     RedrawRecord    : boolean;
  149.     DrawingField    : boolean;
  150.     FieldAltered    : boolean;
  151.     RecordAltered    : boolean;
  152.     JustAltered    : boolean;
  153.     DataAltered    : boolean;
  154.     FieldSelected    : boolean;
  155.     RecordSelected    : boolean;
  156.     RecWasLocked    : boolean;
  157.     LockChecked    : boolean;
  158.     ShowFmt        : showset;
  159.       constructor Init(ATemplate: string;  var AData; BSize: longint;
  160.             var Bounds: TRect;  ALabels,ARecInd: PDmxLink;
  161.             AHScrollBar,AVScrollBar: PScrollBar);
  162.       constructor Load(var S: TStream);
  163.       destructor  Done;  VIRTUAL;
  164.       procedure Store(var S: TStream);
  165.       procedure ChangeBounds(var Bounds: TRect);  VIRTUAL;
  166.       procedure ChangeMade;
  167.       function    CheckRecLock : boolean;
  168.       procedure ClearRecLock;
  169.       procedure Draw;  VIRTUAL;
  170.       procedure DrawField(var Field: pDMXfieldrec);
  171.       procedure EvaluateField;    VIRTUAL;
  172.       procedure EvaluateRecord;  VIRTUAL;
  173.       procedure GetBlob(Num: integer; var Blob: pointer; var Len: integer);
  174.       procedure GotoPos(AFieldNum,ARecNum: integer);
  175.       procedure HandleEvent(var Event: TEvent);  VIRTUAL;
  176.       procedure ProcessCommand(var Command: word;  XY: TPoint);
  177.       procedure ProcessKey(var Event: TEvent);
  178.       procedure ProcessMouse(var Event: TEvent);
  179.       procedure ResetRecLock;  VIRTUAL;
  180.       procedure ScrollDraw;  VIRTUAL;
  181.       function    SetRecLock : boolean;  VIRTUAL;
  182.       procedure SetState(AState: word;  Enable: boolean);  VIRTUAL;
  183.       procedure SetUpField;  VIRTUAL;
  184.       procedure SetUpRecord;  VIRTUAL;
  185.       function    Valid(Command: word) : boolean;  VIRTUAL;
  186.       procedure ZeroizeField(Whole: boolean; Field: pDMXfieldrec);  VIRTUAL;
  187.       procedure ZeroizeRecord;    VIRTUAL;
  188.       private
  189.     FirstPos    : integer;
  190.       procedure ProcessEnter(var Event: TEvent);
  191.     end;
  192.  
  193.  
  194. const
  195.     RDmxExtLabels :  TStreamRec = (
  196.     ObjType:  rnDmxExtLabels;
  197.     VmtLink:  ofs(TypeOf(TDmxExtLabels)^);
  198.     Load:      @TDmxExtLabels.Load;
  199.     Store:      @TDmxExtLabels.Store
  200.       );
  201.  
  202.     RDmxLabels    :  TStreamRec = (
  203.     ObjType:  rnDmxLabels;
  204.     VmtLink:  ofs(TypeOf(TDmxLabels)^);
  205.     Load:      @TDmxLabels.Load;
  206.     Store:      @TDmxLabels.Store
  207.       );
  208.  
  209.     RDmxFLabels    :  TStreamRec = (
  210.     ObjType:  rnDmxFLabels;
  211.     VmtLink:  ofs(TypeOf(TDmxFLabels)^);
  212.     Load:      @TDmxFLabels.Load;
  213.     Store:      @TDmxFLabels.Store
  214.       );
  215.  
  216.     RDmxMLabels    :  TStreamRec = (
  217.     ObjType:  rnDmxMLabels;
  218.     VmtLink:  ofs(TypeOf(TDmxMLabels)^);
  219.     Load:      @TDmxMLabels.Load;
  220.     Store:      @TDmxMLabels.Store
  221.       );
  222.  
  223.     RDmxRecInd    :  TStreamRec = (
  224.     ObjType:  rnDmxRecInd;
  225.     VmtLink:  ofs(TypeOf(TDmxRecInd)^);
  226.     Load:      @TDmxRecInd.Load;
  227.     Store:      @TDmxRecInd.Store
  228.       );
  229.  
  230.     RDmxScroller :  TStreamRec = (
  231.     ObjType:  rnDmxScroller;
  232.     VmtLink:  ofs(TypeOf(TDmxScroller)^);
  233.     Load:      @TDmxScroller.Load;
  234.     Store:      @TDmxScroller.Store
  235.       );
  236.  
  237.     RDmxEditor    :  TStreamRec = (
  238.     ObjType:  rnDmxEditor;
  239.     VmtLink:  ofs(TypeOf(TDmxEditor)^);
  240.     Load:      @TDmxEditor.Load;
  241.     Store:      @TDmxEditor.Store
  242.       );
  243.  
  244.  
  245.   procedure RegisterTVDMX;
  246.  
  247.  
  248. implementation
  249.  
  250. const    NewestDMX    : PDmxScroller    = nil;
  251.     NowScrolling    : boolean    = FALSE;
  252.  
  253. var    FirstField    : pDMXfieldrec;
  254.     Clusters    : array [0..127] of RECORD
  255.         fnum    :  byte;
  256.         value    :  byte;
  257.         ofs    :  word;
  258.     end;
  259.  
  260.  
  261.  
  262.   { ══ TDmxLink ══════════════════════════════════════════════════════════ }
  263.  
  264.  
  265. constructor TDmxLink.Init(var Bounds: TRect);
  266. begin
  267.   TView.Init(Bounds);
  268.   GrowMode  := gfGrowLoY or gfGrowHiY;
  269.   EventMask := evMessage or evMouseDown;
  270.   NewestDMX := Link;
  271. end;
  272.  
  273.  
  274. constructor TDmxLink.Load(var S: TStream);
  275. begin
  276.   TView.Load(S);
  277.   GetPeerViewPtr(S, Link);
  278. end;
  279.  
  280.  
  281. function  TDmxLink.GetPalette : PPalette;
  282. const  P : string[length(cDMX)] = cDMX;
  283. begin
  284.   GetPalette := @P
  285. end;
  286.  
  287.  
  288. procedure TDmxLink.Insert(AOwner: PGroup);
  289. begin
  290.   If (AOwner <> nil) then AOwner^.Insert(@Self);
  291. end;
  292.  
  293.  
  294. procedure TDmxLink.SetState(AState: word; Enable: boolean);
  295. begin
  296.   TView.SetState(AState, Enable);
  297.   If Enable and (AState and sfExposed <> 0) then
  298.     begin
  299.     If (Link = nil) then Link := Message(Owner, evCommand, cmDMX_RollCall, @Self);
  300.     If (Link <> nil) and (Link^.State and sfExposed = 0) then
  301.       begin
  302.       Link^.PutInFrontOf(@Self);
  303.       Link^.SetState(sfExposed, TRUE);
  304.       end;
  305.     end;
  306. end;
  307.  
  308.  
  309. procedure TDmxLink.Store(var S: TStream);
  310. begin
  311.   TView.Store(S);
  312.   PutPeerViewPtr(S, Link);
  313. end;
  314.  
  315.  
  316.   { ══ TDmxExtLabels ═════════════════════════════════════════════════════ }
  317.  
  318. const  Clicked : PDmxLink = nil;
  319.  
  320.  
  321. constructor TDmxExtLabels.Init(ALen: integer; AData: PCharArray; var Bounds: TRect);
  322. begin
  323.   TDmxLink.Init(Bounds);
  324.   Data    := AData;
  325.   Len    := ALen;
  326. end;
  327.  
  328.  
  329. constructor TDmxExtLabels.InitInsert(AOwner: PGroup; ALen: integer; AData: PCharArray);
  330. var  R : TRect;
  331. begin
  332.   AOwner^.GetExtent(R);
  333.   Inc(R.A.Y);
  334.   R.B.Y  := R.A.Y + 2;
  335.   R.Grow(-1, 0);
  336.   TDmxLink.Init(R);
  337.   Data := AData;
  338.   Len  := ALen;
  339.   Insert(AOwner);
  340. end;
  341.  
  342.  
  343. destructor TDmxExtLabels.Done;
  344. begin
  345.   If Heaped and (Data <> nil) and (Len > 0) then FreeMem(Data, Len);
  346.   TDmxLink.Done;
  347. end;
  348.  
  349.  
  350. constructor TDmxExtLabels.Load(var S: TStream);
  351. begin
  352.   TDmxLink.Load(S);
  353.   S.Read(Len, sizeof(Len));
  354.   If Len > 0 then
  355.     begin
  356.     GetMem(Data, Len);
  357.     S.Read(Data^, Len);
  358.     Heaped := TRUE;
  359.     end
  360.    else
  361.     Data := nil;
  362.   S.Read(DblBar,  sizeof(DblBar));
  363. end;
  364.  
  365.  
  366. procedure TDmxExtLabels.Store(var S: TStream);
  367. begin
  368.   TDmxLink.Store(S);
  369.   S.Write(Len, sizeof(Len));
  370.   If Len > 0 then S.Write(Data^, Len);
  371.   S.Write(DblBar,  sizeof(DblBar));
  372. end;
  373.  
  374.  
  375. procedure TDmxExtLabels.Draw;
  376. var  i    : integer;
  377.      A    : string;
  378.      B    : TDrawBuffer;
  379. begin
  380.   If (Link = nil) or (Link^.Delta.X >= Len) then
  381.     fillchar(A[1], Size.X, ' ')
  382.    else
  383.     begin
  384.     Move(Data^[Link^.Delta.X], A[1], Size.X);
  385.     If (Link^.Delta.X + Size.X > Len) then
  386.       fillchar(A[succ(Len - Link^.Delta.X)],(Size.X + Link^.Delta.X - Len), ' ');
  387.     end;
  388.   A[0] := chr(lo(Size.X));
  389.   MoveStr(B, A, GetColor(1));
  390.   If (Link^.Origin.Y <= Origin.Y) then i := pred(Size.Y) else i := 0;
  391.   WriteLine(0, i, Size.X, 1, B);
  392.   If (Size.Y > 1) then DrawRuler((i = 0), DblBar);
  393. end;
  394.  
  395.  
  396. procedure TDmxExtLabels.DrawRuler(Upper, AtLimit: boolean);
  397. const
  398.   LtArr        =  17;
  399.   RtArr        =  16;
  400.   Markers    : string[10] = '─═┬╤╥╦┴╧╨╩';
  401. var
  402.   Color        : word;
  403.   i,X,width    : integer;
  404.   Mk        : integer;
  405.   frontcut    : integer;
  406.   fieldrec    : pDMXfieldrec;
  407.   A        : string;
  408.   B        : TDrawBuffer;
  409. begin
  410.   If (longint(Size) = 0) or (Link = nil) or (Link^.DMXfield1 = nil) then Exit;
  411.   fieldrec  := Link^.LeftField;
  412.   If (fieldrec = nil) or (fieldrec^.screentab > Link^.Delta.X) then
  413.     fieldrec := Link^.DMXfield1;
  414.   If (fieldrec^.Next <> nil) then
  415.     While (fieldrec^.Next^.screentab <= Link^.Delta.X) and
  416.       (fieldrec^.Next <> nil)
  417.      do
  418.       fieldrec := fieldrec^.Next;
  419.   frontcut  := Link^.Delta.X - fieldrec^.screentab;
  420.   If frontcut < 0 then frontcut := 0;
  421.   X := 0;
  422.   If (Clicked = @Self) then Color := GetColor(6) else Color := GetColor(5);
  423.   If AtLimit then Mk := 2 else Mk := 1;
  424.   MoveChar(B, Markers[Mk], Color, Size.X);
  425.   Inc(Mk, 2);
  426.   If not Upper then Inc(Mk, 4);
  427.   If (Clicked <> @Self) then While (X < Size.X) do
  428.     begin
  429.     With fieldrec^ do
  430.       begin
  431.       If (access and accHidden = 0) then
  432.     begin
  433.     If access and accDelimiter <> 0 then
  434.       begin
  435.       If fieldrec^.typecode = '║' then char(B[X]) := Markers[Mk + 2]
  436.        else If fieldrec^.typecode = '│' then char(B[X]) := Markers[Mk];
  437.       Inc(X);
  438.       end
  439.      else
  440.       begin
  441.       X := X + shownwid - frontcut;
  442.       end;
  443.     frontcut := 0;
  444.     end;
  445.       end;
  446.     fieldrec := fieldrec^.Next;
  447.     If (fieldrec = nil) and (Size.X > X) then X := Size.X;
  448.     end;
  449.   If Upper then i := pred(Size.Y) else i := 0;
  450.   WriteLine(0, i, Size.X, succ(i), B);
  451. end;
  452.  
  453.  
  454. procedure TDmxExtLabels.HandleEvent(var Event: TEvent);
  455. var  dX,dY  : integer;
  456.      Cmd    : word;
  457.      db        : boolean;
  458. begin
  459.   TDmxLink.HandleEvent(Event);
  460.   With Event do
  461.     If (What and evMouseDown <> 0) then
  462.       begin
  463.       If (Link = nil) then Exit;
  464.       If (Link^.State and sfSelected = 0) then
  465.     Link^.Select
  466.        else
  467.     begin
  468.     Repeat
  469.       Clicked := @Self;
  470.       db := DblBar;
  471.       DblBar := TRUE;
  472.       DrawView;
  473.       If (Link^.Origin.Y <= Origin.Y) then Cmd := cmDMX_Down else Cmd := cmDMX_Up;
  474.       Message(Link, evCommand, Cmd, @Self);
  475.       Application^.Idle;
  476.       Clicked := nil;
  477.       DblBar := db;
  478.       DrawView;
  479.     Until not MouseEvent(Event, evMouseDown or evMouseAuto);
  480.     end;
  481.       ClearEvent(Event);
  482.       end
  483.     else
  484.     If (What and evMessage <> 0) then
  485.       begin
  486.       If (Command = cmDMX_ScrollBarChanged) then
  487.     begin
  488.     If (InfoPtr = Link) then DrawView;
  489.     end
  490.       else
  491.       If (Command = cmDMX_FixSize) and (Size.X > Len)
  492.     and (Link <> nil) and (Link^.Labels = @Self) then
  493.     begin
  494.     dX := (Owner^.Size.X - Size.X) + Len;
  495.     dY :=  Owner^.Size.Y;
  496.     Owner^.GrowTo(dX, dY);
  497.     end;
  498.       end;
  499. end;
  500.  
  501.  
  502. procedure TDmxExtLabels.SetState(AState: word; Enable: boolean);
  503. var  L : longint;
  504. begin
  505.   TDmxLink.SetState(AState, Enable);
  506.   If Enable and (AState and sfExposed <> 0) and (Link <> nil) then
  507.     begin
  508.     If (Link^.Origin.Y <= Origin.Y) then
  509.       GrowMode := gfGrowHiX or gfGrowLoY or gfGrowHiY
  510.      else
  511.       GrowMode := gfGrowHiX;
  512.     end;
  513. end;
  514.  
  515.  
  516.   { ══ TDmxLabels ════════════════════════════════════════════════════════ }
  517.  
  518.  
  519. constructor TDmxLabels.Init(DataStr: pstring;    var Bounds: TRect);
  520. begin
  521.   TDmxLink.Init(Bounds);
  522.   Move(DataStr, Data, sizeof(Data));
  523.   Len := length(DataStr^);
  524.   Inc(PtrRec(Data).Ofs);
  525. end;
  526.  
  527.  
  528. constructor TDmxLabels.InitInsert(AOwner: PGroup;  DataStr: pstring);
  529. var  R : TRect;
  530. begin
  531.   AOwner^.GetExtent(R);
  532.   Inc(R.A.Y);
  533.   R.B.Y := R.A.Y + 2;
  534.   R.Grow(-1, 0);
  535.   TDmxLink.Init(R);
  536.   Move(DataStr, Data, sizeof(Data));
  537.   Len := length(DataStr^);
  538.   Inc(PtrRec(Data).Ofs);
  539.   Insert(AOwner);
  540. end;
  541.  
  542.  
  543.   { ══ TDmxFLabels ═══════════════════════════════════════════════════════ }
  544.  
  545.  
  546. constructor TDmxFLabels.Init(LabelStr: string;  var Bounds: TRect);
  547. begin
  548.   TDmxLink.Init(Bounds);
  549.   Len := length(LabelStr);
  550.   If (Len > 0) then
  551.     begin
  552.     GetMem(Data, Len);
  553.     Move(LabelStr[1], Data^, Len);
  554.     Heaped := TRUE;
  555.     end;
  556. end;
  557.  
  558.  
  559. constructor TDmxFLabels.InitInsert(AOwner: PGroup;  LabelStr: string);
  560. var  R : TRect;
  561. begin
  562.   AOwner^.GetExtent(R);
  563.   Inc(R.A.Y);
  564.   R.B.Y := R.A.Y + 2;
  565.   R.Grow(-1, 0);
  566.   TDmxFLabels.Init(LabelStr, R);
  567.   Insert(AOwner);
  568. end;
  569.  
  570.  
  571.   { ══ TDmxMLabels ═══════════════════════════════════════════════════════ }
  572.  
  573.  
  574. constructor TDmxMLabels.Init(Labels: PSItem;  var Bounds: TRect);
  575. var  i : integer;
  576. begin
  577.   TDmxLink.Init(Bounds);
  578.   Len := SItemsLen(Labels);
  579.   If (Len > 0) then
  580.     begin
  581.     GetMem(Data, Len);
  582.     i := 0;
  583.     While (Labels <> nil) do
  584.       begin
  585.       If (Labels^.Value <> nil) then
  586.     begin
  587.     Move(Labels^.Value^[1], Data^[i], length(Labels^.Value^));
  588.     Inc(i, length(Labels^.Value^));
  589.     end;
  590.       Labels := Labels^.Next;
  591.       end;
  592.     Heaped := TRUE;
  593.     end;
  594. end;
  595.  
  596.  
  597. constructor TDmxMLabels.InitInsert(AOwner: PGroup;  Labels: PSItem);
  598. var  R : TRect;
  599. begin
  600.   AOwner^.GetExtent(R);
  601.   Inc(R.A.Y);
  602.   R.B.Y := R.A.Y + 2;
  603.   R.Grow(-1, 0);
  604.   TDmxMLabels.Init(Labels, R);
  605.   Insert(AOwner);
  606. end;
  607.  
  608.  
  609.   { ══ TDmxScroller ══════════════════════════════════════════════════════ }
  610.  
  611.  
  612. constructor TDmxScroller.Init(ATemplate: string;  var AData;
  613.                   BSize: longint;  var Bounds: TRect;
  614.                   ALabels: PView;
  615.                   AHScrollBar,AVScrollBar: PScrollBar);
  616. var  L : longint;
  617. begin
  618.   TScroller.Init(Bounds, AHScrollBar, AVScrollBar);
  619.   FillChar(Clusters, sizeof(Clusters), 0);
  620.   NewestDMX    := @Self;
  621.   Labels    := PDmxLink(ALabels);
  622.   If Labels <> nil then Labels^.Link := @Self;
  623.   InitValid    := TRUE;
  624.   DataBlockSize    := BSize;
  625.   WorkingData    := @AData;
  626.   Limit.X    := 0;
  627.   InitStruct(ATemplate);
  628.   InitData(AData);
  629.   If (RecordSize > 0) then
  630.     begin
  631.     L := RecordSize;
  632.     L := DataBlockSize div L;
  633.     SetLimit(Limit.X, L);
  634.     end;
  635.   LeftField := DMXfield1;
  636.   GrowMode  := gfGrowHiX or gfGrowHiY;
  637. end;
  638.  
  639.  
  640. destructor TDmxScroller.Done;
  641. begin
  642.   If (NewestDMX = @Self) then NewestDMX := nil;
  643.   DoneData;
  644.   DoneStruct;
  645.   TScroller.Done;
  646. end;
  647.  
  648.  
  649. constructor TDmxScroller.Load(var S: TStream);
  650. begin
  651.   TScroller.Load(S);
  652.   InitValid := TRUE;
  653.   GetPeerViewPtr(S, Labels);
  654.   S.Read(TotalFields, sizeof(TotalFields));
  655.   S.Read(RecordSize,  sizeof(RecordSize));
  656.   S.Read(ActualRecordNum, sizeof(ActualRecordNum));
  657.   S.Read(CurrentRecord, sizeof(CurrentRecord));
  658.   S.Read(BaseRecord,    sizeof(BaseRecord));
  659.   S.Read(DataBlockSize, sizeof(DataBlockSize));
  660.   InBuffer  := FALSE;
  661.   LoadData(S);
  662.   LoadStruct(S);
  663. end;
  664.  
  665.  
  666. procedure TDmxScroller.Store(var S: TStream);
  667. begin
  668.   TScroller.Store(S);
  669.   PutPeerViewPtr(S, Labels);
  670.   S.Write(TotalFields, sizeof(TotalFields));
  671.   S.Write(RecordSize,  sizeof(RecordSize));
  672.   S.Write(ActualRecordNum, sizeof(ActualRecordNum));
  673.   S.Write(CurrentRecord, sizeof(CurrentRecord));
  674.   S.Write(BaseRecord,     sizeof(BaseRecord));
  675.   S.Write(DataBlockSize, sizeof(DataBlockSize));
  676.   StoreData(S);
  677.   StoreStruct(S);
  678. end;
  679.  
  680.  
  681. procedure TDmxScroller.ChangeBounds(var Bounds: TRect);
  682. begin
  683.   InBuffer := FALSE;
  684.   TScroller.ChangeBounds(Bounds);
  685. end;
  686.  
  687.  
  688. function  TDmxScroller.DataAt(RecNum: integer) : pointer;
  689. begin
  690.   DataAt := ptr(PtrRec(WorkingData).Seg, PtrRec(WorkingData).Ofs + RecNum * RecordSize);
  691. end;
  692.  
  693.  
  694. procedure TDmxScroller.DoneData;
  695. begin
  696. end;
  697.  
  698.  
  699. procedure TDmxScroller.DoneStruct;
  700. var  P : pDMXfieldrec;
  701. begin
  702.   While (DMXfield1 <> nil) do
  703.     begin
  704.     P := DMXfield1^.Next;
  705.     If DMXfield1^.template <> nil then
  706.       begin
  707.       If (upcase(DMXfield1^.typecode) = fldENUM) then
  708.     DisposeSItems(PSItem(DMXfield1^.template))
  709.        else
  710.     DisposeStr(DMXfield1^.template);
  711.       end;
  712.     Dispose(DMXfield1);
  713.     DMXfield1 := P;
  714.     end;
  715.   LeftField    := nil;
  716. end;
  717.  
  718.  
  719. var  EmptyRecord : byte;
  720.  
  721.  
  722. procedure TDmxScroller.Draw;
  723. var
  724.   i,rows,Y,owid  :  integer;
  725.   A   :  string;
  726.   B   :  TDrawBuffer;
  727.   Buf : ^TDrawBuffer;
  728. begin
  729.   HideCursor;
  730.   rows := Size.Y;
  731.   Y    := -1;
  732.   FirstField := nil;
  733.   If (Owner^.Buffer <> nil) and InBuffer then
  734.     begin
  735.     If (Delta.X = DDelta.X) and (abs(Delta.Y - DDelta.Y) = 1) and
  736.        (Size.Y > 1) and (longint(Size) = longint(DSize))
  737.      then  { use part of the owner's buffer if this is a 1 line scroll }
  738.       begin
  739.       owid := Owner^.Size.X shl 1;
  740.       longint(Buf) := longint(Owner^.Buffer) + ((Origin.Y * owid) + (Origin.X shl 1));
  741.       If (Delta.Y > DDelta.Y) then  { Down }
  742.     begin
  743.     For i := 0 to(Size.Y - 2) do
  744.       begin
  745.       ptrrec(Buf).ofs := ptrrec(Buf).ofs + owid;
  746.       WriteBuf(0, i, Size.X, 1, Buf^);
  747.       end;
  748.     Y := Size.Y - 2;
  749.     end
  750.        else  { Up }
  751.     begin
  752.     ptrrec(Buf).ofs := ptrrec(Buf).ofs + ((Size.Y - 2) * owid);
  753.     For i := (Size.Y - 1) downto 1 do
  754.       begin
  755.       WriteBuf(0, i, Size.X, 1, Buf^);
  756.       ptrrec(Buf).ofs := ptrrec(Buf).ofs - owid;
  757.       end;
  758.     Rows := 1;
  759.     end;
  760.       end;
  761.     end;
  762.   If rows > 0 then
  763.     begin
  764.     While (Y < pred(rows)) do
  765.       begin
  766.       Inc(Y);
  767.       DrawingRecNum := Y + Delta.Y;
  768.       If Y + Delta.Y < Limit.Y then
  769.     DrawRecord(Y, DataAt(DrawingRecNum)^)
  770.        else
  771.     DrawRecord(Y, EmptyRecord);
  772.       end;
  773.     end;
  774.   DDelta   := Delta;
  775.   DSize    := Size;
  776.   InBuffer := (Owner^.Buffer <> nil);
  777.   If NowScrolling then
  778.     begin
  779.     Message(Owner, evBroadcast, cmDMX_ScrollBarChanged, @Self);
  780.     NowScrolling := FALSE;
  781.     end;
  782. end;
  783.  
  784.  
  785. procedure TDmxScroller.DrawRecord(Y: integer;    var DataRecord );
  786. var Color        : word;
  787.     ColorA, ColorB    : word;
  788.     I,X, width        : integer;
  789.     frontcut        : integer;
  790.     fieldrec        : pDMXfieldrec;
  791.     A            : string;
  792.     B            : TDrawBuffer;
  793. begin
  794.   If (FirstField <> DMXfield1) then
  795.     begin
  796.     FirstField := DMXfield1;
  797.     LeftField  := DMXfield1;
  798.     While (LeftField^.Next <> nil) and
  799.       (LeftField^.Next^.screentab <= Delta.X)
  800.      do
  801.       LeftField := LeftField^.Next;
  802.     end;
  803.   If (LeftField = nil) then Exit;
  804.   fieldrec := LeftField;
  805.   frontcut := Delta.X - fieldrec^.screentab;
  806.   X       := 0;
  807.   ColorA   := GetColor(1);
  808.   ColorB   := GetColor(5);
  809.   While (X < Size.X) do
  810.     begin
  811.     With fieldrec^ do
  812.       begin
  813.       If (access and accHidden = 0) then
  814.     begin
  815.     If access and accDelimiter <> 0 then
  816.       begin
  817.       A    := typecode;
  818.       Color := ColorB;
  819.       end
  820.      else
  821.       begin
  822.       If (@DataRecord = @EmptyRecord) then
  823.         begin
  824.         A[0] := chr(fieldrec^.shownwid);
  825.         fillchar(A[1], fieldrec^.shownwid, ' ');
  826.         end
  827.        else
  828.         A    := FieldString(fieldrec,[], DataRecord);
  829.       If fieldsize > 0 then Color := ColorA else Color := ColorB;
  830.       FieldText(A, Color, fieldrec, DataRecord);
  831.       If length(A) > shownwid then A[0] := chr(shownwid);
  832.       If frontcut > 0 then Delete(A, 1, frontcut);
  833.       end;
  834.     frontcut := 0;
  835.     MoveStr(B[X], A, Color);
  836.     X  := X + length(A);
  837.     end;
  838.       end;
  839.     fieldrec := fieldrec^.Next;
  840.     If (fieldrec = nil) and (Size.X > X) then
  841.       begin
  842.       MoveChar(B[X], ' ', ColorB, Size.X - X);
  843.       X  := Size.X;
  844.       end;
  845.     end;
  846.   WriteLine(0, Y, Size.X, 1, B);
  847. end;
  848.  
  849.  
  850. procedure TDmxScroller.FieldText(var S: string;  var Color: word;
  851.                  Field: pDMXfieldrec;  var DataRec );
  852. begin
  853. end;
  854.  
  855.  
  856. procedure TDmxScroller.GetData(var Rec );
  857. begin
  858.   pointer(Rec) := WorkingData
  859. end;
  860.  
  861.  
  862. function  TDmxScroller.GetPalette : PPalette;
  863. const  P : string[length(cDMX)] = cDMX;
  864. begin
  865.   GetPalette := @P
  866. end;
  867.  
  868.  
  869. procedure TDmxScroller.HandleEvent(var Event: TEvent);
  870. var  WasHere : boolean;
  871. begin
  872.   TScroller.HandleEvent(Event);
  873.   With Event do
  874.     If (What and evMessage <> 0) then
  875.       begin
  876.       WasHere := TRUE;
  877.       If (Command = cmDMX_RollCall) then
  878.     begin
  879.     If (InfoPtr <> nil) and (InfoPtr <> @Self) then
  880.       Message(InfoPtr, evCommand, cmDMX_Ack, @Self);
  881.     end
  882.       else
  883.       If (((Command = cmDMX_DrawData) and (WorkingData = InfoPtr)) or
  884.       ((Command = cmDMX_Draw) and
  885.       ((InfoPtr = nil) or (PDmxScroller(InfoPtr)^.WorkingData = WorkingData) or (What = evCommand))))
  886.       then DrawView
  887.       else
  888.       If not Locked and (((Command = cmDMX_LockData) and (WorkingData = InfoPtr)) or
  889.     ((Command = cmDMX_Lock) and
  890.     ((InfoPtr = nil) or (PDmxScroller(InfoPtr)^.WorkingData = WorkingData) or (What = evCommand))))
  891.       then Locked := TRUE
  892.       else
  893.       If Locked and (((Command = cmDMX_UnlockData) and (WorkingData = InfoPtr)) or
  894.     ((Command = cmDMX_Unlock) and
  895.     ((InfoPtr = nil) or (PDmxScroller(InfoPtr)^.WorkingData = WorkingData) or (What = evCommand))))
  896.       then Locked := FALSE
  897.       else
  898.     WasHere := FALSE;
  899.       If WasHere and (What = evCommand) then ClearEvent(Event);
  900.       end;
  901. end;
  902.  
  903.  
  904. procedure TDmxScroller.InitData(var AData );
  905. begin
  906.   WorkingData := @AData;
  907. end;
  908.  
  909.  
  910. procedure TDmxScroller.InitStruct(var ATemplate );
  911. var
  912.   SameFieldNum    :  boolean;
  913.   WasSameNum    :  boolean;
  914.   NoFieldNum    :  boolean;
  915.   NoFieldAdv    :  boolean;
  916.   AllZeroes    :  boolean;
  917.   C        :  char;
  918.   DoDecimal    :  integer;
  919.   Rex,X        :  pDMXfieldrec;
  920.   templx    :  string;
  921.  
  922.   procedure NewRecord;
  923.   var i,j : integer;
  924.       A   : pstring;
  925.   begin
  926.     If not InitValid then Exit;
  927.     With Rex^ do
  928.       begin
  929.       If DoDecimal > 0 then Rex^.decimals := pred(DoDecimal);
  930.       DoDecimal := 0;
  931.       If (fieldsize = 0) then
  932.     access := access or accSkip
  933.        else
  934.     If not NoFieldAdv then
  935.       begin
  936.       If not NoFieldNum then
  937.         If SameFieldNum then
  938.           fieldnum := succ(TotalFields)
  939.          else
  940.           If TRUE or (access and accHidden = 0) or WasSameNum then
  941.         begin
  942.         Inc(TotalFields);
  943.         fieldnum := TotalFields;
  944.         end;
  945.       datatab    := RecordSize;
  946.       RecordSize := RecordSize + fieldsize;
  947.       end;
  948.       screentab  := Limit.X;
  949.       If (typecode = fldBOOLEAN) and (truelen = 0) then showzeroes := FALSE;
  950.       If (upcase(typecode) = fldENUM) then
  951.     begin
  952.     columnwid := truelen;
  953.     end
  954.        else
  955.     begin
  956.     If (columnwid = 0) then columnwid := length(templx);
  957.     If (length(templx) > 0) or (template <> nil) then
  958.       begin
  959.       If (MaxAvail > length(templx)) then
  960.         template  := NewStr(templx)
  961.        else
  962.         InitValid := FALSE;
  963.       end
  964.      else
  965.       begin
  966.       If (typecode <> #0) and (access and accHidden = 0) then Inc(Limit.X);
  967.       end;
  968.     end;
  969.       If (shownwid = 0) then shownwid := columnwid;
  970.       If access and accHidden = 0 then Limit.X := Limit.X + shownwid;
  971.       end;
  972.     templx := '';
  973.     If (MaxAvail > sizeof(Rex^)) then
  974.       begin
  975.       New(Rex^.Next);
  976.       X   := Rex;
  977.       Rex := Rex^.Next;
  978.       fillchar(Rex^, sizeof(Rex^), 0);
  979.       Rex^.Prev := X;
  980.       Rex^.Next := nil;
  981.       Rex^.showzeroes := AllZeroes;
  982.       end
  983.      else
  984.       InitValid := FALSE;
  985.     WasSameNum := FALSE;
  986.     NoFieldNum := FALSE;
  987.     NoFieldAdv := FALSE;
  988.   end;
  989.  
  990.   procedure TranslateStruct(dataformat: pstring);
  991.   var  df   : pstring;
  992.        i,j  : integer;
  993.        TS   : PSItem;
  994.   begin
  995.     SameFieldNum := FALSE;
  996.     WasSameNum     := FALSE;
  997.     NoFieldNum     := FALSE;
  998.     NoFieldAdv     := FALSE;
  999.     DoDecimal :=  0;
  1000.     i := 1;
  1001.     While (i <= length(dataformat^)) do
  1002.       begin
  1003.       C := upcase(dataformat^[i]);
  1004.       Case C of
  1005.     fldSTR, fldSTRNUM:
  1006.       With Rex^ do
  1007.         begin
  1008.         templx   := templx + #0;
  1009.         typecode := dataformat^[i];
  1010.         Inc(truelen);
  1011.         If fieldsize > 0 then
  1012.           Inc(fieldsize)
  1013.          else
  1014.           begin
  1015.           fieldsize :=  2;
  1016.           fillvalue := ' ';
  1017.           end;
  1018.         end;
  1019.     fldCHAR, fldCHARVAL, fldCHARNUM:
  1020.       With Rex^ do
  1021.         begin
  1022.         templx    := templx + #0;
  1023.         typecode  := dataformat^[i];
  1024.         Inc(truelen);
  1025.         Inc(fieldsize);
  1026.         fillvalue := ' ';
  1027.         If DoDecimal > 0 then Inc(DoDecimal);
  1028.         end;
  1029.     fldBYTE, fldSHORTINT, fldBOOLEAN:
  1030.       With Rex^ do
  1031.         begin
  1032.         templx    := templx + #0;
  1033.         If upcase(C) <> fldSHORTINT then C := upcase(C);
  1034.         typecode  := dataformat^[i];
  1035.         Inc(truelen);
  1036.         fieldsize := sizeof(BYTE);
  1037.         fillvalue := #0;
  1038.         end;
  1039.     ^X :
  1040.       With Rex^ do
  1041.         begin
  1042.         typecode  := fldBOOLEAN;
  1043.         truelen   := 0;
  1044.         fieldsize := sizeof(BOOLEAN);
  1045.         fillvalue := #0;
  1046.         end;
  1047.     fldZEROMOD:  { 'Z' }
  1048.       With Rex^ do
  1049.         begin
  1050.         If (typecode = #0) or (typecode = fldCHARVAL) then Inc(fieldsize);
  1051.         templx := templx + #1;
  1052.         Inc(truelen);
  1053.         If DoDecimal > 0 then Inc(DoDecimal);
  1054.         end;
  1055.     fldWORD, fldINTEGER:
  1056.       With Rex^ do
  1057.         begin
  1058.         templx    := templx + #0;
  1059.         typecode  := dataformat^[i];
  1060.         Inc(truelen);
  1061.         fieldsize := sizeof(INTEGER);
  1062.         fillvalue := #0;
  1063.         end;
  1064.     fldLONGINT:
  1065.       With Rex^ do
  1066.         begin
  1067.         templx    := templx + #0;
  1068.         typecode  := dataformat^[i];
  1069.         Inc(truelen);
  1070.         fieldsize := sizeof(LONGINT);
  1071.         fillvalue := #0;
  1072.         end;
  1073.     fldHEXVALUE:
  1074.       With Rex^ do
  1075.         begin
  1076.         templx    := templx + #0;
  1077.         typecode  := dataformat^[i];
  1078.         Inc(truelen);
  1079.         fieldsize := succ(truelen) shr 1;
  1080.         fillvalue := #0;
  1081.         end;
  1082.     fldREALNUM:
  1083.       With Rex^ do
  1084.         begin
  1085.         templx    := templx + #0;
  1086.         typecode  := dataformat^[i];
  1087.         Inc(truelen);
  1088.         fieldsize := sizeof(TREALNUM);
  1089.         fillvalue := #0;
  1090.         If DoDecimal > 0 then Inc(DoDecimal);
  1091.         end;
  1092.     fldENUM:
  1093.       begin
  1094.       If (templx <> '') then NewRecord;
  1095.       Move(dataformat^[succ(i)], Rex^.template, sizeof(Rex^.template));
  1096.       Rex^.typecode      := fldENUM;
  1097.       Rex^.truelen      := MaxItemStrLen(PSItem(Rex^.template));
  1098.       Rex^.fieldsize  := sizeof(BYTE);
  1099.       Rex^.showzeroes := boolean(dataformat^[i+5]);
  1100.       Rex^.access      := byte(dataformat^[i+6]);
  1101.       Rex^.fillvalue  := dataformat^[i+7];
  1102.       Inc(i, sizeof(DmxIDstr) - 2);
  1103.       NewRecord;
  1104.       end;
  1105.     fldCLUSTER:
  1106.       begin
  1107.       Rex^.typecode  := dataformat^[i];
  1108.       Rex^.fieldsize := SizeOfFldCluster;
  1109.       Inc(i);
  1110.       j := ord(dataformat^[i]);
  1111.       If (Clusters[j].fnum = 0) then
  1112.         begin
  1113.         Clusters[j].fnum := succ(TotalFields);
  1114.         Clusters[j].ofs  := RecordSize;
  1115.         end
  1116.        else
  1117.         begin
  1118.         Inc(Clusters[j].value);
  1119.         Rex^.fieldnum := Clusters[j].fnum;
  1120.         Rex^.decimals := Clusters[j].value;
  1121.         Rex^.datatab  := Clusters[j].ofs;
  1122.         NoFieldNum := TRUE;
  1123.         NoFieldAdv := TRUE;
  1124.         end;
  1125.       Rex^.fieldnum := Clusters[j].fnum;
  1126.       templx := templx + #0;
  1127.       Inc(Rex^.truelen);
  1128.       end;
  1129.     fldBLOB:
  1130.       begin
  1131.       If (templx <> '') then NewRecord;
  1132.       Rex^.typecode     := fldBLOB;
  1133.       Move(dataformat^[succ(i)], Rex^.fieldsize, sizeof(Rex^.fieldsize));
  1134.       Move(dataformat^[i+1], Rex^.fieldsize, sizeof(Rex^.fieldsize));
  1135.       Rex^.access     := byte(dataformat^[i+6]) or accHidden;
  1136.       Rex^.fillvalue := dataformat^[i+7];
  1137.       Inc(i, sizeof(DmxIDstr) - 2);
  1138.       NewRecord;
  1139.       end;
  1140.     #27:  { [Esc] }
  1141.       begin
  1142.       Inc(i);
  1143.       If (templx <> '') then NewRecord;
  1144.       Case dataformat^[i] of
  1145.         fldXFIELDNUM:
  1146.           begin
  1147.           TotalFields := ord(dataformat^[succ(i)]) - 1;
  1148.           Inc(i);
  1149.           end;
  1150.         fldXSPACES, fldXTABTO:
  1151.           begin
  1152.           If (dataformat^[i] = fldXSPACES) then
  1153.         Rex^.truelen := ord(dataformat^[i+2])
  1154.            else
  1155.         If (ord(dataformat^[i+2]) > Limit.X) then
  1156.           Rex^.truelen := Limit.X - ord(dataformat^[i+2]);
  1157.           If (Rex^.truelen > 0) then
  1158.         begin
  1159.         Rex^.typecode  := #27;
  1160.         Rex^.fillvalue := dataformat^[i+1];
  1161.         Rex^.shownwid  := Rex^.truelen;
  1162.         Inc(i, 3);
  1163.         NewRecord;
  1164.         end;
  1165.           end;
  1166.         end;
  1167.       end;
  1168.     fldAPPEND:
  1169.       begin
  1170.       If (templx <> '') then NewRecord;
  1171.       Move(dataformat^[succ(i)], df, sizeof(df));
  1172.       TranslateStruct(df);
  1173.       Inc(i, sizeof(DmxIDstr) - 2);
  1174.       end;
  1175.     fldSITEMS:
  1176.       begin
  1177.       If (templx <> '') then NewRecord;
  1178.       Move(dataformat^[succ(i)], TS, sizeof(TS));
  1179.       While (TS <> nil) do
  1180.         begin
  1181.         If (TS^.Value <> nil) then TranslateStruct(TS^.Value);
  1182.         TS := TS^.Next;
  1183.         end;
  1184.       Inc(i, sizeof(DmxIDstr) - 2);
  1185.       end;
  1186.     ')','.':
  1187.       With Rex^ do
  1188.         begin
  1189.         templx := templx + C;
  1190.         If (upcase(Rex^.typecode) = fldCHARVAL) then
  1191.           begin
  1192.           If (C = ')') then Inc(truelen);
  1193.           Inc(fieldsize);
  1194.           end;
  1195.         If (C = '.') then
  1196.           begin
  1197.           If (upcase(typecode) = fldREALNUM) or
  1198.          (upcase(typecode) = fldCHARVAL) then
  1199.         DoDecimal := 1;
  1200.           end
  1201.          else
  1202.           parenthesis := TRUE;
  1203.         end;
  1204.     '~':
  1205.       begin
  1206.       Inc(i);
  1207.       While (dataformat^[i] <> '~') and (i <= length(dataformat^)) do
  1208.         begin
  1209.         C := dataformat^[i];
  1210.         If C = #0 then C := ' ';
  1211.         If C = #1 then C := #2;
  1212.         templx := templx + C;
  1213.         Inc(i);
  1214.         end;
  1215.       end;
  1216.     #0,'\','|','│','║':
  1217.       begin
  1218.       If (templx <> '') then NewRecord;
  1219.       If C <> #0 then
  1220.         begin
  1221.         If C = '|' then C := '│' else If C = '\' then C := ' ';
  1222.         Rex^.access    := Rex^.access or accDelimiter;
  1223.         Rex^.typecode  := C;
  1224.         NewRecord;
  1225.         end;
  1226.       end;
  1227.     ^A:
  1228.       begin
  1229.       AllZeroes    := not AllZeroes;
  1230.       Rex^.showzeroes := AllZeroes;
  1231.       end;
  1232.     ^C:
  1233.       begin
  1234.       Inc(i);
  1235.       Rex^.access := Rex^.access or ord(dataformat^[i]);
  1236.       end;
  1237.     ^D:
  1238.       begin
  1239.       If (templx <> '') then NewRecord;
  1240.       Inc(i);
  1241.       C := dataformat^[i];
  1242.       Rex^.access     := Rex^.access or accDelimiter;
  1243.       Rex^.typecode  := C;
  1244.       NewRecord;
  1245.       end;
  1246.     ^F:
  1247.       begin
  1248.       If (i < length(dataformat^)) and (dataformat^[i+1] = ^F) then
  1249.         begin
  1250.         NoFieldNum := TRUE;
  1251.         Inc(i);
  1252.         end
  1253.        else
  1254.         begin
  1255.         WasSameNum     := SameFieldNum;
  1256.         SameFieldNum := not SameFieldNum;
  1257.         end;
  1258.       end;
  1259.     ^H:   With Rex^ do access := access or accHidden;
  1260.     ^P:   With Rex^ do
  1261.         begin
  1262.         Inc(i);
  1263.         RecordSize := RecordSize + shortint(dataformat^[i]);
  1264.         end;
  1265.     ^R:   With Rex^ do access := access or accReadOnly;
  1266.     ^S:   With Rex^ do access := access or accSkip;
  1267.     ^U:   With Rex^ do
  1268.         begin
  1269.         Inc(i);
  1270.         upperlimit := byte(dataformat^[i]);
  1271.         end;
  1272.     ^V:   With Rex^ do
  1273.         begin
  1274.         Inc(i);
  1275.         fillvalue := dataformat^[i];
  1276.         end;
  1277.     ^Z:   Rex^.showzeroes := TRUE;
  1278.     fldCONTRACTION:   With Rex^ do shownwid := length(templx);
  1279.        else
  1280.       begin
  1281.       templx := templx + dataformat^[i];
  1282.       end;
  1283.     end;  { case of C }
  1284.       Inc(i);
  1285.       end;
  1286.   end;
  1287.  
  1288. begin
  1289.   If (@ATemplate = nil) then Exit;
  1290.   AllZeroes := FALSE;
  1291.   templx    := '';
  1292.   New(Rex);
  1293.   fillchar(Rex^, sizeof(Rex^), 0);
  1294.   Rex^.Next := nil;
  1295.   Rex^.Prev := nil;
  1296.   Rex^.showzeroes := AllZeroes;
  1297.   X := nil;
  1298.   If DMXfield1 = nil then
  1299.     DMXfield1 := Rex
  1300.    else
  1301.     begin
  1302.     X := DMXfield1;
  1303.     While X^.Next <> nil do X := X^.Next;
  1304.     X^.Next := Rex;
  1305.     Rex^.Prev := X;
  1306.     end;
  1307.   TranslateStruct(@ATemplate);
  1308.   SameFieldNum := FALSE;
  1309.   If templx <> '' then NewRecord;
  1310.   If (Rex = DMXfield1) then DMXfield1 := nil;
  1311.   Dispose(Rex);
  1312.   If (X <> nil) then X^.Next := nil;
  1313.   If DMXfield1 <> nil then DMXfield1^.Prev := X;
  1314. end;
  1315.  
  1316.  
  1317. procedure TDmxScroller.LoadData(var S: TStream);
  1318. begin
  1319. end;
  1320.  
  1321.  
  1322. procedure TDmxScroller.LoadStruct(var S: TStream);
  1323. var n     : integer;
  1324.     P,Px : pDMXfieldrec;
  1325. begin
  1326.   DMXfield1 := nil;
  1327.   S.Read(n, sizeof(n));
  1328.   Px := nil;
  1329.   While (n > 0) do
  1330.     begin
  1331.     GetMem(P, sizeof(P^));
  1332.     S.Read(P^, sizeof(P^));
  1333.     If (P^.template <> nil) then
  1334.       begin
  1335.       If upcase(P^.typecode) = fldENUM then
  1336.     P^.template := pstring(ReadSItems(S))
  1337.        else
  1338.     P^.template := S.ReadStr;
  1339.       end;
  1340.     If DMXfield1 = nil then DMXfield1 := P;
  1341.     If Px <> nil then Px^.Next := P;
  1342.     P^.Prev := Px;
  1343.     P^.Next := nil;
  1344.     Px        := P;
  1345.     Dec(n);
  1346.     end;
  1347.   LeftField := DMXfield1;
  1348.   If DMXfield1 <> nil then DMXfield1^.Prev := P;
  1349. end;
  1350.  
  1351.  
  1352. function  TDmxScroller.RecNumStr(RecNum: integer) : string;
  1353. var  S : string;
  1354. begin
  1355.   If (RecNum >= RecordLimit) then
  1356.     RecNumStr := '      '
  1357.    else
  1358.     begin
  1359.     Str(succ(RecNum):5, S);
  1360.     RecNumStr := S + ' ';
  1361.     end;
  1362. end;
  1363.  
  1364.  
  1365. function  TDmxScroller.RecordLimit : longint;
  1366. var  RecSize: longint;
  1367. begin
  1368.   RecSize := RecordSize;
  1369.   If (RecordSize > 0) then
  1370.     RecordLimit := (DataBlockSize div RecSize)
  1371.    else
  1372.     RecordLimit := 0;
  1373. end;
  1374.  
  1375.  
  1376. procedure TDmxScroller.ScrollDraw;
  1377. begin
  1378.   NowScrolling := ((HScrollBar <> nil) and (HScrollBar^.Value <> Delta.X)) or
  1379.           ((VScrollBar <> nil) and (VScrollBar^.Value <> Delta.Y));
  1380.   TScroller.ScrollDraw;
  1381. end;
  1382.  
  1383.  
  1384. procedure TDmxScroller.SetData(var Rec );
  1385. begin
  1386.   WorkingData := pointer(Rec)
  1387. end;
  1388.  
  1389.  
  1390. procedure TDmxScroller.SetState(AState: word; Enable: boolean);
  1391. var  L1,L2 : longint;
  1392. begin
  1393.   If (AState and sfActive <> 0) then
  1394.     begin
  1395.     If Enable then
  1396.       begin
  1397.       If (RecordSize > 0) then
  1398.     begin
  1399.     L1 := RecordSize;
  1400.     L2 := L1 * Limit.Y;
  1401.     L1 := DataBlockSize - (DataBlockSize mod L1);
  1402.     If (L1 <> L2) then
  1403.       begin
  1404.       L1 := RecordSize;
  1405.       L1 := DataBlockSize div L1;
  1406.       If (Limit.Y <> L1) then SetLimit(Limit.X, L1);
  1407.       end;
  1408.     end;
  1409.       end;
  1410.     end;
  1411.   If (AState and sfFocused <> 0) and (Application <> nil) then
  1412.     begin
  1413.     If Enable then
  1414.       TScroller.SetState(sfCursorIns, Application^.GetState(sfCursorIns))
  1415.      else
  1416.       Application^.SetState(sfCursorIns, GetState(sfCursorIns));
  1417.     end;
  1418.   TScroller.SetState(AState, Enable);
  1419. end;
  1420.  
  1421.  
  1422. procedure TDmxScroller.StoreData(var S: TStream);
  1423. begin
  1424. end;
  1425.  
  1426.  
  1427. procedure TDmxScroller.StoreStruct(var S: TStream);
  1428. var  n : integer;
  1429.      P : pDMXfieldrec;
  1430. begin
  1431.   n  := 0;
  1432.   P  := DMXfield1;
  1433.   While (P <> nil) do
  1434.     begin
  1435.     Inc(n);
  1436.     P := P^.Next;
  1437.     end;
  1438.   S.Write(n, sizeof(n));
  1439.   P := DMXfield1;
  1440.   While (P <> nil) do
  1441.     begin
  1442.     S.Write(P^, sizeof(P^));
  1443.     If (P^.template <> nil) then
  1444.       begin
  1445.       If upcase(P^.typecode) = fldENUM then
  1446.     WriteSItems(S, PSItem(P^.template))
  1447.        else
  1448.     S.WriteStr(P^.template);
  1449.       end;
  1450.     P := P^.Next;
  1451.     end;
  1452. end;
  1453.  
  1454.  
  1455. function  TDmxScroller.Valid(Command: word) : boolean;
  1456. var  V : boolean;
  1457. begin
  1458.   V := TScroller.Valid(Command);
  1459.   If (Command = cmValid) then V := V and InitValid;
  1460.   Valid := V;
  1461. end;
  1462.  
  1463.  
  1464. procedure TDmxScroller.WrongKeypressed(var Event: TEvent);
  1465. begin
  1466.   Message(Application, evCommand, cmDMX_WrongKey, @Self);
  1467. end;
  1468.  
  1469.  
  1470.   { ══ TDmxRecInd ════════════════════════════════════════════════════════ }
  1471.  
  1472.  
  1473. constructor TDmxRecInd.Init(var Bounds: TRect;  Len: integer);
  1474. begin
  1475.   TDmxLink.Init(Bounds);
  1476.   GrowMode  := gfGrowLoY or gfGrowHiY;
  1477. end;
  1478.  
  1479.  
  1480. constructor TDmxRecInd.InitInsert(AOwner: PGroup; Len: integer);
  1481. var  R : TRect;
  1482. begin
  1483.   AOwner^.GetExtent(R);
  1484.   Inc(R.A.X);
  1485.   R.A.Y  := pred(R.B.Y);
  1486.   R.Grow(-1, 0);
  1487.   If (R.B.X - R.A.X > Len) then R.B.X := R.A.X + Len;
  1488.   R.B.Y  := succ(R.A.Y);
  1489.   TDmxLink.Init(R);
  1490.   GrowMode  := gfGrowLoY or gfGrowHiY;
  1491.   Insert(AOwner);
  1492. end;
  1493.  
  1494.  
  1495. procedure TDmxRecInd.Draw;
  1496. var  A    : string;
  1497.      B    : TDrawBuffer;
  1498.      C    : word;
  1499. begin
  1500.   C := GetColor(6);
  1501.   MoveChar(B, '═', C, Size.X);
  1502.   Str(succ(Link^.CurrentRecord):1, A);
  1503.   If length(A) > Size.X then
  1504.     MoveChar(B, showOVERFLOW, C, Size.X)
  1505.    else
  1506.     begin
  1507.     If length(A) < Size.X then A := A + ' ';
  1508.     If length(A) < Size.X then A := ' ' + A;
  1509.     MoveStr(B[succ((Size.X) - length(A)) shr 1], A, C);
  1510.     end;
  1511.   WriteBuf(0, 0, Size.X, 1, B);
  1512. end;
  1513.  
  1514.  
  1515. procedure TDmxRecInd.HandleEvent(var Event: TEvent);
  1516. begin
  1517.   TDmxLink.HandleEvent(Event);
  1518.   With Event do
  1519.     begin
  1520.     If (What and evMouseDown <> 0) then
  1521.       begin
  1522.       Message(Application, evCommand, cmDMX_RecIndClicked, @Self);
  1523.       ClearEvent(Event);
  1524.       end;
  1525.     end;
  1526. end;
  1527.  
  1528.  
  1529. procedure TDmxRecInd.SetState(AState: word;  Enable: boolean);
  1530. begin
  1531.   If (AState and (sfActive or sfDragging) <> 0) then
  1532.     TDmxLink.SetState(sfVisible, Enable xor (AState and sfDragging <> 0));
  1533.   TDmxLink.SetState(AState, Enable);
  1534. end;
  1535.  
  1536.  
  1537.   { ══ TDmxEditor ═══════════════════════════════════════════════════════ }
  1538.  
  1539.  
  1540. constructor TDmxEditor.Init(ATemplate: string;  var AData;  BSize: longint;
  1541.                 var Bounds: TRect;  ALabels,ARecInd: PDmxLink;
  1542.                 AHScrollBar,AVScrollBar: PScrollBar);
  1543. var  inbounds  : TRect;
  1544. begin
  1545.   TDmxScroller.Init(ATemplate, AData, BSize, Bounds, ALabels, AHScrollBar, AVScrollBar);
  1546.   CurrentField := DMXfield1;
  1547.   While (CurrentField <> nil) and
  1548.     (CurrentField^.access and (accHidden or accSkip or accDelimiter) <> 0)
  1549.    do
  1550.     CurrentField := CurrentField^.Next;
  1551.   CurrentRecord  := 0;
  1552.   RecInd := ARecInd;
  1553.   If RecInd <> nil then
  1554.     begin
  1555.     RecInd^.Link := @Self;
  1556.     If (HScrollBar <> nil) then
  1557.       begin
  1558.       HScrollBar^.GetBounds(inbounds);
  1559.       inbounds.A.X := inbounds.A.X + RecInd^.Size.X + 1;
  1560.       HScrollBar^.Locate(inbounds);
  1561.       end;
  1562.     end;
  1563. end;
  1564.  
  1565.  
  1566. constructor TDmxEditor.Load(var S: TStream);
  1567. var  i,n : integer;
  1568. begin
  1569.   TDmxScroller.Load(S);
  1570.   GetPeerViewPtr(S, RecInd);
  1571.   CurrentField := DMXfield1;
  1572.   S.Read(n, sizeof(n));
  1573.   i := 0;
  1574.   While (i <> n) and (CurrentField <> nil) do
  1575.     begin
  1576.     CurrentField := CurrentField^.Next;
  1577.     Inc(i);
  1578.     end;
  1579.   If CurrentField = nil then CurrentField := DMXfield1;
  1580.   S.Read(Locked, sizeof(Locked));
  1581. end;
  1582.  
  1583.  
  1584. destructor TDmxEditor.Done;
  1585. begin
  1586.   If FieldSelected and (CurrentField <> nil) then EvaluateField;
  1587.   If RecordSelected then EvaluateRecord;
  1588.   TDmxScroller.Done;
  1589. end;
  1590.  
  1591.  
  1592. procedure TDmxEditor.Store(var S: TStream);
  1593. var n  : integer;
  1594.     df : pDMXfieldrec;
  1595. begin
  1596.   TDmxScroller.Store(S);
  1597.   PutPeerViewPtr(S, RecInd);
  1598.   df := DMXfield1;
  1599.   n  := 0;
  1600.   While (df <> CurrentField) do
  1601.     begin
  1602.     df := df^.Next;
  1603.     Inc(n);
  1604.     end;
  1605.   S.Write(n, sizeof(n));
  1606.   S.Write(Locked, sizeof(Locked));
  1607. end;
  1608.  
  1609.  
  1610. procedure TDmxEditor.ChangeBounds(var Bounds: TRect);
  1611. var  i,j    : integer;
  1612.      ReScroll    : boolean;
  1613.      RS,FS    : boolean;
  1614.      xy        : TPoint;
  1615. begin
  1616.   RS := RecordSelected;
  1617.   FS := FieldSelected;
  1618.   If FS then EvaluateField;
  1619.   If RS then EvaluateRecord;
  1620.   TDmxScroller.ChangeBounds(Bounds);
  1621.   ReScroll := FALSE;
  1622.   If CurrentField <> nil then With CurrentField^ do
  1623.     If (template <> nil) then
  1624.       begin
  1625.       xy := Delta;
  1626.       If (Size.X - (screentab - Delta.X) < 0) or
  1627.      (Size.X <= shownwid) then
  1628.     begin
  1629.     xy.X  := screentab + shownwid - Size.X;
  1630.     If (Size.X <= shownwid) then xy.X := screentab else If (xy.X > 0) then Inc(xy.X);
  1631.     ReScroll := TRUE;
  1632.     end
  1633.        else
  1634.     If (Size.X - (screentab + shownwid - Delta.X) < 0) then
  1635.       begin
  1636.       xy.X    := screentab + shownwid - Size.X;
  1637.       ReScroll := TRUE;
  1638.       end;
  1639.       end;
  1640.     If (Size.Y - (CurrentRecord - Delta.Y) <= 0) then
  1641.       begin
  1642.       xy.Y := succ(CurrentRecord - Size.Y);
  1643.       If xy.Y < 0 then xy.Y := 0;
  1644.       ReScroll := TRUE;
  1645.       end;
  1646.   If ReScroll then ScrollTo(xy.X, xy.Y);
  1647.   If RS then SetupRecord;
  1648.   If FS then SetupField;
  1649. end;
  1650.  
  1651.  
  1652. procedure TDmxEditor.ChangeMade;
  1653. begin
  1654.   FieldAltered    := TRUE;
  1655.   RecordAltered := TRUE;
  1656.   JustAltered    := TRUE;
  1657.   DataAltered    := TRUE;
  1658. end;
  1659.  
  1660.  
  1661. function  TDmxEditor.CheckRecLock : boolean;
  1662. begin
  1663.   If not LockChecked then
  1664.     begin
  1665.     RecWasLocked := not SetRecLock;
  1666.     LockChecked  := TRUE;
  1667.     end;
  1668.   CheckRecLock := not RecWasLocked;
  1669. end;
  1670.  
  1671.  
  1672. procedure TDmxEditor.ClearRecLock;
  1673. begin
  1674.   If LockChecked then
  1675.     begin
  1676.     If not RecWasLocked then ResetRecLock;
  1677.     LockChecked := FALSE;
  1678.     end;
  1679.   RecWasLocked := FALSE;
  1680. end;
  1681.  
  1682.  
  1683. procedure TDmxEditor.Draw;
  1684. begin
  1685.   If (Owner <> nil) then
  1686.     begin
  1687.     Owner^.Lock;
  1688.     TDmxScroller.Draw;
  1689.     If (FieldSelected and (showanyway in ShowFmt)) or
  1690.        (RecordSelected and (showCurrentField in ShowFmt)
  1691.     and (CurrentRecord < Limit.Y))
  1692.      then
  1693.       DrawField(CurrentField);
  1694.     Owner^.Unlock;
  1695.     end;
  1696. end;
  1697.  
  1698.  
  1699. procedure TDmxEditor.DrawField(var Field: pDMXfieldrec);
  1700. const
  1701.   rpoint = #16;
  1702.   lpoint = #17;
  1703. var
  1704.   Color  : word;
  1705.   i,j,k  : integer;
  1706.   x1,x2  : integer;
  1707.   Len     : integer;
  1708.   front  : boolean;
  1709.   hyde     : boolean;
  1710.   S     : string;
  1711.   B     : TDrawBuffer;
  1712. begin
  1713.   If (Field = nil) then Exit;
  1714.   DrawingRecNum := CurrentRecord;
  1715.   If RedrawRecord then
  1716.     begin
  1717.     If (RecordData <> nil) then DrawRecord(CurrentRecord-Delta.Y, RecordData^);
  1718.     RedrawRecord := FALSE;
  1719.     end;
  1720.   DrawingField := (showanyway in ShowFmt) or (showCurrentField in ShowFmt);
  1721.   hyde := TRUE;
  1722.   With Field^ do If (truelen > 0) or ((template <> nil) and (shownwid > 0)) then
  1723.     begin
  1724.     If (access and (accHidden or accDelimiter) = 0) then
  1725.       begin
  1726.       If (showanyway in ShowFmt) then CurrentCurPos := CurPos;
  1727.       S  := FieldString(Field, ShowFmt, RecordData^);
  1728.       x1 := screentab - Delta.X;
  1729.       x2 := x1 + length(S);
  1730.       If x1 < 0 then
  1731.     begin
  1732.     x1 := 0;
  1733.     front := FALSE;
  1734.     end
  1735.        else
  1736.     front := TRUE;
  1737.       If x2 - x1 > shownwid then x2 := x1 + shownwid;
  1738.       If x2 > Size.X then x2 := Size.X;
  1739.       Len  := x2 - x1;
  1740.       If Len > 0 then
  1741.     begin
  1742.     If not (showregular in ShowFmt) and FieldSelected then
  1743.       begin
  1744.       If (access and accReadOnly <> 0) then
  1745.         Color := GetColor(3)
  1746.        else
  1747.         If Locked or RecWasLocked then
  1748.           Color := GetColor(4)
  1749.          else
  1750.           begin
  1751.           hyde := FALSE;
  1752.           Color := GetColor(2);
  1753.           end;
  1754.       If hyde and (Color = GetColor(1)) then Color := Color or $80;
  1755.       FieldText(S, Color, Field, RecordData^);
  1756.       j := 0;
  1757.       k := 0;
  1758.       If (fieldsize > 0) then
  1759.         begin
  1760.         If (upcase(typecode) = fldENUM) then
  1761.           begin
  1762.           For i := length(S) downto 1 do If (S[i] <> ' ') then k := i;
  1763.           end
  1764.          else
  1765.           For i := 1 to length(S) do
  1766.         If (ord(template^[i]) and $FE = 0) then
  1767.           begin
  1768.           If (CurPos >= j) then k := i;
  1769.           Inc(j);
  1770.           end;
  1771.         end;
  1772.       If k > 0 then
  1773.         begin
  1774.         If CurPos = 0 then FirstPos := 0;
  1775.         If (CurPos = truelen) and (length(S) > Len) then
  1776.           FirstPos := length(S) - Len;
  1777.         If length(S) <= Len then
  1778.           begin
  1779.           FirstPos := 0;
  1780.           end
  1781.          else
  1782.           begin
  1783.           If pred(k) <= FirstPos then
  1784.         begin
  1785.         FirstPos := pred(k);
  1786.         If FirstPos > 0 then
  1787.           begin
  1788.           Delete(S, 1,FirstPos);
  1789.           k := k - FirstPos;
  1790.           end;
  1791.         end
  1792.            else
  1793.         begin
  1794.         j := 0;
  1795.         If FirstPos > 0 then
  1796.           begin
  1797.           Delete(S, 1,FirstPos);
  1798.           k := k - FirstPos;
  1799.           j := FirstPos;
  1800.           end;
  1801.         If length(S) > Len then
  1802.           begin
  1803.           If k > Len then
  1804.             begin
  1805.             i := k - Len;
  1806.             FirstPos := i + j;
  1807.             If i > 0 then Delete(S, 1, i);
  1808.             k := k - i;
  1809.             end;
  1810.           end;
  1811.         end;
  1812.           end;
  1813.         If Len > 3 then
  1814.           begin
  1815.           If (k = Len) and (length(S) > Len) then
  1816.         begin
  1817.         Delete(S, 1,1);
  1818.         Inc(FirstPos);
  1819.         Dec(k);
  1820.         end;
  1821.           If (FirstPos > 0) then
  1822.         begin
  1823.         If k > 1 then S[1] := lpoint
  1824.          else
  1825.           begin
  1826.           System.Insert(lpoint, S, 1);
  1827.           Inc(k);
  1828.           Inc(FirstPos);
  1829.           end;
  1830.         end;
  1831.           If length(S) > Len then S[Len] := rpoint;
  1832.           end;
  1833.         SetCursor(pred(k) + x1, CurrentRecord - Delta.Y);
  1834.         end;
  1835.       end
  1836.      else
  1837.       begin
  1838.       If DrawingField and RecordSelected and not FieldSelected and
  1839.          (showCurrentField in ShowFmt) and (CurrentField = Field) then
  1840.         Color := GetColor(6)
  1841.        else
  1842.         Color := GetColor(1);
  1843.       FieldText(S, Color, Field, RecordData^);
  1844.       If (length(S) > Len) and not front then Delete(S, 1, length(S) - Len);
  1845.       end;
  1846.     MoveStr(B, S, Color);
  1847.     i := CurrentRecord - Delta.Y;
  1848.     WriteLine(x1, i, Len, 1, B);
  1849.     end;
  1850.       end;
  1851.     end;
  1852.   If hyde or (k = 0) then HideCursor else ShowCursor;
  1853.   DrawingField := FALSE;
  1854. end;
  1855.  
  1856.  
  1857. procedure TDmxEditor.EvaluateField;
  1858. begin
  1859.   If FieldAltered then Message(Owner, evBroadcast, cmDMX_FieldAltered, @Self);
  1860.   FieldSelected := FALSE;
  1861.   ShowFmt   := ShowFmt + [showregular] - [shownegative] - [showanyway];
  1862.   DrawField(CurrentField);
  1863.   ShowFmt   := ShowFmt - [showregular];
  1864. end;
  1865.  
  1866.  
  1867. procedure TDmxEditor.EvaluateRecord;
  1868. begin
  1869.   ClearRecLock;
  1870.   RecordSelected := FALSE;
  1871.   DrawRecord(CurrentRecord - Delta.Y, RecordData^);
  1872. end;
  1873.  
  1874.  
  1875. procedure TDmxEditor.GetBlob(Num: integer; var Blob: pointer; var Len: integer);
  1876. var  i     : integer;
  1877.      Fld : pDMXfieldrec;
  1878. begin
  1879.   Blob := nil;
  1880.   Len  := 0;
  1881.   If (Num <= 0) then Exit;
  1882.   i    := 0;
  1883.   Fld  := DMXfield1;
  1884.   While (i < Num) do
  1885.     begin
  1886.     While (Fld <> nil) and (Fld^.typecode <> fldBLOB) do Fld := Fld^.Next;
  1887.     Inc(i);
  1888.     end;
  1889.   If (Fld <> nil) then
  1890.     begin
  1891.     Blob := RecordData;
  1892.     Inc(word(Blob), Fld^.datatab);
  1893.     Len  := Fld^.fieldsize;
  1894.     end;
  1895. end;
  1896.  
  1897.  
  1898. procedure TDmxEditor.GotoPos(AFieldNum,ARecNum: integer);
  1899. var X,Y      : integer;
  1900.     RS,FS : boolean;
  1901.     F      : pDMXfieldrec;
  1902. begin
  1903.   RS := RecordSelected;
  1904.   If RS then
  1905.     begin
  1906.     FS := FieldSelected;
  1907.     If FS then EvaluateField;
  1908.     If (CurrentRecord = ARecNum) then RS := FALSE;
  1909.     If RS then EvaluateRecord;
  1910.     end
  1911.    else
  1912.     FS := FALSE;
  1913.   CurrentRecord := ARecNum;
  1914.   If not RecordSelected then
  1915.     begin
  1916.     Y := CurrentRecord - (Size.Y shr 1);
  1917.     If (Y < 0) then Y := 0;
  1918.     end
  1919.    else
  1920.     Y := Delta.Y;
  1921.   F := DMXfield1;
  1922.   While (F <> nil) and (F^.fieldnum <> AFieldNum) do F := F^.Next;
  1923.   If (F = nil) or (AFieldNum = 0) then
  1924.     X := Delta.X
  1925.    else
  1926.     begin
  1927.     X := F^.screentab;
  1928.     CurrentField := F;
  1929.     end;
  1930.   If (X > Limit.X) then X := Limit.X;
  1931.   If (Y > Limit.Y) then Y := Limit.Y;
  1932.   ScrollTo(X, Y);
  1933.   If RS then SetupRecord;
  1934.   If FS then SetupField;
  1935. end;
  1936.  
  1937.  
  1938. procedure TDmxEditor.HandleEvent(var Event: TEvent);
  1939. var  XY    : TPoint;
  1940.      Cmd: word;
  1941.      RS,FS : boolean;
  1942.     function  OK4Command : boolean;
  1943.     begin
  1944.       With Event do
  1945.     OK4Command := (What = evCommand) or (InfoPtr = nil) or
  1946.       ((PDmxScroller(InfoPtr)^.WorkingData = WorkingData));
  1947.     end;
  1948. begin
  1949.   RS := FALSE;
  1950.   FS := FALSE;
  1951.   With Event do
  1952.     begin
  1953.     If not GetState(sfDragging) then
  1954.       begin
  1955.       If (What = evKeyDown) and (CharCode in [^M,^T,^Y]) then
  1956.     begin
  1957.     Case CharCode of
  1958.       ^M:    Cmd := cmDMX_Enter;
  1959.       ^Y:    Cmd := cmDMX_ZeroizeRecord;
  1960.      else    Cmd := cmDMX_ZeroizeField;
  1961.       end;
  1962.     Message(TopView, evCommand, Cmd, @Self);
  1963.     ClearEvent(Event);
  1964.     end;
  1965.       Case What of
  1966.     evNothing:   begin end;
  1967.     evMouseDown: ProcessMouse(Event);
  1968.     evKeyDown:
  1969.         If (KeyCode <> kbEsc) and (Size.Y > 0) and (What = evKeyDown) then
  1970.           ProcessKey(Event);
  1971.     evCommand:
  1972.         If (Command = cmDMX_DoubleClick) and (InfoPtr = @Self) then
  1973.           begin
  1974.           Case upcase(CurrentField^.typecode) of
  1975.         fldBOOLEAN:  Message(@Self, evKeyDown, ord('_'), @Self);
  1976.         fldENUM:     Message(@Self, evKeyDown, kbGrayPlus, @Self);
  1977.         end;
  1978.           end
  1979.         else
  1980.         If (Command >= cmDMX_ZeroizeField) and (Command <= cmDMX_Bottom)
  1981.         and Valid(Command)
  1982.         then
  1983.           begin
  1984.           If Command = cmDMX_Enter then ProcessEnter(Event);
  1985.           If (Command <> 0) then
  1986.         begin
  1987.         Move(InfoPtr, XY, sizeof(XY));
  1988.         ProcessCommand(Command, XY);
  1989.         end;
  1990.           If (Command = 0) then ClearEvent(Event);
  1991.           end;
  1992.     end;
  1993.       end;
  1994.     If (What and evMessage <> 0) then
  1995.       If ((Command = cmDMX_DrawData) and (WorkingData = InfoPtr)) or
  1996.      ((Command = cmDMX_LockData) and (WorkingData = InfoPtr)) or
  1997.      ((Command = cmDMX_UnlockData) and (WorkingData = InfoPtr)) or
  1998.      ((Command = cmDMX_Draw) and OK4Command) or
  1999.      ((Command = cmDMX_Lock) and OK4Command) or
  2000.      ((Command = cmDMX_Unlock) and OK4Command)
  2001.        then
  2002.     begin
  2003.     RS := RecordSelected;
  2004.     If RS then
  2005.       begin
  2006.       FS := FieldSelected;
  2007.       If FS then EvaluateField;
  2008.       EvaluateRecord;
  2009.       end;
  2010.     end;
  2011.     end;
  2012.   If (Event.What <> evNothing) then
  2013.     begin
  2014.     If (Event.What = evKeyDown) and ((Size.X <= 0) or (Size.Y <= 0)) then
  2015.       TView.HandleEvent(Event) else TDmxScroller.HandleEvent(Event);
  2016.     end;
  2017.   If RS then
  2018.     begin
  2019.     SetupRecord;
  2020.     If FS then SetupField;
  2021.     end;
  2022. end;
  2023.  
  2024.  
  2025. procedure TDmxEditor.ProcessCommand(var Command: word;  XY: TPoint);
  2026. var
  2027.   i,j    : word;
  2028.   xx,yy : integer;
  2029.   DoIt    : integer;
  2030.   F    : pDMXfieldrec;
  2031.   RS,FS,Chg : boolean;
  2032.  
  2033.     procedure DoHome;
  2034.     begin
  2035.       F := DMXfield1;
  2036.       If F <> nil then
  2037.     begin
  2038.     While (F^.access and (accHidden or accSkip or accDelimiter) <> 0)
  2039.       and (F^.Next <> nil)
  2040.      do
  2041.       F := F^.Next;
  2042.     CurrentField := F;
  2043.     end;
  2044.       If CurrentField <> nil then With CurrentField^ do
  2045.     begin
  2046.     xx := 0;
  2047.     If (screentab + shownwid - 1 > Size.X) then xx := screentab;
  2048.     end;
  2049.     end;
  2050.  
  2051. begin
  2052.   RS    := RecordSelected;
  2053.   FS    := FieldSelected;
  2054.   If (Command = cmDMX_ZeroizeField) then
  2055.     begin
  2056.     If FS then Chg := TRUE else Exit;
  2057.     end
  2058.    else
  2059.     Chg    := FALSE;
  2060.   DoIt    :=  0;
  2061.   xx    := Delta.X;
  2062.   yy    := Delta.Y;
  2063.   If (Command >= cmDMX_Enter) and (Command <= cmDMX_Bottom) then
  2064.     begin
  2065.     If FS then EvaluateField;
  2066.     DoIt  :=  1;
  2067.     If (Command > cmDMX_goto) then
  2068.       begin
  2069.       If RS then EvaluateRecord;
  2070.       DoIt  :=    2;
  2071.       end;
  2072.     end;
  2073.   If ReDrawRecord then
  2074.     begin
  2075.     DrawingRecNum := CurrentRecord;
  2076.     DrawRecord(CurrentRecord - Delta.Y, RecordData^);
  2077.     ReDrawRecord := FALSE;
  2078.     end;
  2079.  
  2080.   Case Command of
  2081.  
  2082.     cmDMX_ZeroizeField:
  2083.     begin
  2084.     If FieldSelected then
  2085.       begin
  2086.       EvaluateField;
  2087.       SetupField;
  2088.       end;
  2089.     ZeroizeField(TRUE, CurrentField);
  2090.     end;
  2091.  
  2092.     cmDMX_ZeroizeRecord:
  2093.     begin
  2094.     If FieldSelected then
  2095.       begin
  2096.       EvaluateField;
  2097.       SetupField;
  2098.       end;
  2099.     ZeroizeRecord;
  2100.     end;
  2101.  
  2102.     cmDMX_Left:
  2103.     If CurrentField <> DMXfield1 then
  2104.       begin
  2105.       F := CurrentField^.Prev;
  2106.       While (F <> nil) and (F^.access and (accHidden or accSkip or accDelimiter) <> 0)
  2107.        do
  2108.         begin
  2109.         If F = DMXfield1 then F := nil else F := F^.Prev;
  2110.         end;
  2111.       If F <> nil then CurrentField := F;
  2112.       If CurrentField <> nil then With CurrentField^ do
  2113.         begin
  2114.         If (screentab < xx) then
  2115.           begin
  2116.           xx := screentab;
  2117.           If (xx > 0) and (Size.X > shownwid) then Dec(xx);
  2118.           end;
  2119.         end;
  2120.       end;
  2121.  
  2122.     cmDMX_Right:
  2123.     begin
  2124.     F := CurrentField^.Next;
  2125.     While (F <> nil) and (F^.access and (accHidden or accSkip or accDelimiter) <> 0)
  2126.      do F := F^.Next;
  2127.     If F <> nil then CurrentField := F;
  2128.     If CurrentField <> nil then With CurrentField^ do
  2129.       begin
  2130.       If (screentab + shownwid - 1 > xx + pred(Size.X)) then
  2131.         begin
  2132.         xx := screentab + shownwid - Size.X;
  2133.         If (xx < Limit.X) and (Size.X > shownwid) then Inc(xx);
  2134.         end;
  2135.       end;
  2136.     end;
  2137.  
  2138.     cmDMX_Home:  DoHome;
  2139.  
  2140.     cmDMX_End:
  2141.     begin
  2142.     F := CurrentField;
  2143.     If F <> nil then
  2144.       begin
  2145.       While (F^.Next <> nil) do F := F^.Next;
  2146.       While (F^.access and (accHidden or accSkip or accDelimiter) <> 0)
  2147.         and (F^.Prev <> nil)
  2148.        do
  2149.         F := F^.Prev;
  2150.       CurrentField := F;
  2151.       xx := Limit.X;
  2152.       With CurrentField^ do
  2153.         If (screentab < xx) then
  2154.           begin
  2155.           xx := screentab;
  2156.           If (xx > 0) and (Size.X > shownwid) then Dec(xx);
  2157.           end;
  2158.       end;
  2159.     end;
  2160.  
  2161.     cmDMX_goto:
  2162.     begin
  2163.     F := CurrentField;
  2164.     DoubleValid := FALSE;
  2165.     If F <> nil then
  2166.       begin
  2167.       While (F <> nil) and ((F^.access and accHidden <> 0) or (F^.screentab < XY.x))
  2168.          and (F^.Next <> nil)
  2169.        do F := F^.Next;
  2170.       If (F <> nil) then
  2171.         begin
  2172.         While (F <> nil) and ((F^.access and accHidden <> 0) or (F^.screentab > XY.x))
  2173.          do F := F^.Prev;
  2174.         DoubleValid := (F^.fieldsize <> 0);
  2175.         If (XY.x > Delta.X + (Size.X shr 1)) then
  2176.           begin
  2177.           While (F <> nil) and (F^.fieldsize = 0) do F := F^.Next;
  2178.           end
  2179.          else
  2180.           While (F <> nil) and (F <> DMXfield1) and (F^.fieldsize = 0) do
  2181.         F := F^.Prev;
  2182.         If (F <> nil) and (F^.access and (accDelimiter or accSkip) = 0) then
  2183.           begin
  2184.           With F^ do
  2185.         begin
  2186.         If (screentab < xx) then
  2187.           begin
  2188.           xx := screentab;
  2189.           If (xx > 0) and (Size.X > shownwid) then Dec(xx);
  2190.           end
  2191.          else
  2192.           begin
  2193.           If (screentab + shownwid - 1 > xx + pred(Size.X)) then
  2194.             begin
  2195.             xx := screentab + shownwid - Size.X;
  2196.             If (xx < Limit.X) and (Size.X > shownwid) then Inc(xx);
  2197.             end;
  2198.           end;
  2199.         end;
  2200.           If (CurrentRecord = XY.y) then
  2201.         CurrentField := F
  2202.            else
  2203.         begin
  2204.         If RS then EvaluateRecord;
  2205.         DoIt  :=  2;
  2206.         If ReDrawRecord then
  2207.           begin
  2208.           DrawingRecNum := CurrentRecord;
  2209.           DrawRecord(CurrentRecord - Delta.Y, RecordData^);
  2210.           ReDrawRecord := FALSE;
  2211.           end;
  2212.         CurrentField  :=  F;
  2213.         CurrentRecord := XY.y;
  2214.         If CurrentRecord >= Limit.Y then CurrentRecord := pred(Limit.Y);
  2215.         end;
  2216.           end
  2217.          else DoubleValid := FALSE;
  2218.         end;
  2219.       end;
  2220.     end;
  2221.  
  2222.     cmDMX_NextRow:
  2223.     begin
  2224.     If succ(CurrentRecord) < Limit.Y then
  2225.       begin
  2226.       Inc(CurrentRecord);
  2227.       If yy + Size.Y <= CurrentRecord then
  2228.         yy := CurrentRecord - Size.Y + 1;
  2229.       If yy < 0 then yy := 0;
  2230.       end;
  2231.     DoHome;
  2232.     end;
  2233.  
  2234.     cmDMX_Up:
  2235.     begin
  2236.     If CurrentRecord > 0 then
  2237.       begin
  2238.       Dec(CurrentRecord);
  2239.       If yy > CurrentRecord then yy := CurrentRecord;
  2240.       end;
  2241.     end;
  2242.  
  2243.     cmDMX_Down:
  2244.     begin
  2245.     If succ(CurrentRecord) < Limit.Y then
  2246.       begin
  2247.       Inc(CurrentRecord);
  2248.       If yy + Size.Y <= CurrentRecord then
  2249.         yy := CurrentRecord - Size.Y + 1;
  2250.       If yy < 0 then yy := 0;
  2251.       end;
  2252.     end;
  2253.  
  2254.     cmDMX_PgUp:
  2255.     begin
  2256.     CurrentRecord := CurrentRecord - Size.Y + 1;
  2257.     If CurrentRecord < 0 then CurrentRecord := 0;
  2258.     yy := FirstRow - Size.Y + 1;
  2259.     If yy < 0 then
  2260.       begin
  2261.       yy := 0;
  2262.       CurrentRecord := 0;
  2263.       end;
  2264.     end;
  2265.  
  2266.     cmDMX_PgDn:
  2267.     begin
  2268.     CurrentRecord := CurrentRecord + Size.Y - 1;
  2269.     If CurrentRecord >= Limit.Y then
  2270.       CurrentRecord := pred(Limit.Y);
  2271.     If CurrentRecord < 0 then CurrentRecord := 0;
  2272.     yy := FirstRow + Size.Y - 1;
  2273.     If yy < 0 then
  2274.       begin
  2275.       yy := 0;
  2276.       CurrentRecord := 0;
  2277.       end;
  2278.     If yy > Limit.Y + Size.Y - 1 then yy := Limit.Y + Size.Y - 1;
  2279.     end;
  2280.  
  2281.     cmDMX_ScreenTop:  CurrentRecord := Delta.Y;
  2282.  
  2283.     cmDMX_ScreenBottom:
  2284.     begin
  2285.     CurrentRecord := Delta.Y + Size.Y - 1;
  2286.     If CurrentRecord > Limit.Y then CurrentRecord := pred(Limit.Y);
  2287.     end;
  2288.  
  2289.     cmDMX_Top:
  2290.     begin
  2291.     CurrentRecord := 0;
  2292.     yy := 0;
  2293.     end;
  2294.  
  2295.     cmDMX_Bottom:
  2296.     begin
  2297.     CurrentRecord := pred(Limit.Y);
  2298.     If CurrentRecord < 0 then CurrentRecord := 0;
  2299.     yy := pred(Limit.Y);
  2300.     end;
  2301.  
  2302.    else begin  end;
  2303.  
  2304.     end;
  2305.  
  2306.   If DoIt <> 0 then
  2307.     begin
  2308.     If (xx <> Delta.X) or (yy <> Delta.Y) then ScrollTo(xx, yy);
  2309.     FirstRow := Delta.Y;
  2310.     Command := 0;
  2311.     If (DoIt > 1) and RS then SetUpRecord;
  2312.     If (DoIt > 0) and FS then SetUpField;
  2313.     end;
  2314.   If Chg then ChangeMade;
  2315.   If ReDrawRecord then
  2316.     begin
  2317.     DrawingRecNum := CurrentRecord;
  2318.     DrawField(CurrentField);
  2319.     end;
  2320. end;
  2321.  
  2322.  
  2323. procedure TDmxEditor.ProcessEnter(var Event: TEvent);
  2324.  
  2325.     function  NextFieldExists : boolean;
  2326.     var  F : pDMXfieldrec;
  2327.     begin
  2328.       F := CurrentField^.Next;
  2329.       While (F <> nil) and
  2330.         (F^.access and (accHidden or accSkip or accDelimiter) <> 0)
  2331.        do  F := F^.Next;
  2332.       NextFieldExists := (F <> nil);
  2333.     end;
  2334.  
  2335. begin
  2336.   If NextFieldExists then
  2337.     Event.Command := cmDMX_Right
  2338.    else
  2339.     begin
  2340.     Event.What := evCommand;
  2341.     Event.Command := cmDMX_NextRow;
  2342.     HandleEvent(Event);
  2343.     ClearEvent(Event);
  2344.     end;
  2345. end;
  2346.  
  2347.  
  2348. procedure TDmxEditor.ProcessKey(var Event: TEvent);
  2349. var i,j,k : integer;
  2350.     inx   : integer;
  2351.     TC      : char;
  2352.     Go      : boolean;
  2353.     InsOn : boolean;
  2354.     A      : string[80];
  2355.     DFld  : pDMXfieldrec;
  2356.  
  2357.   procedure QuitField(Command: word);
  2358.   begin
  2359.     Event.What      := evCommand;
  2360.     Event.Command := Command;
  2361.     HandleEvent(Event);
  2362.     Event.KeyCode := kbNoKey;
  2363.     ClearEvent(Event);
  2364.   end;
  2365.  
  2366.   procedure SetBoolean(B: boolean);
  2367.   begin
  2368.     pboolean(FieldData)^ := B;
  2369.     ChangeMade;
  2370.     DrawField(CurrentField);
  2371.     If not (Event.CharCode in [^G,^H,'_']) then QuitField(cmDMX_Enter);
  2372.   end;
  2373.  
  2374.   procedure ToggleCluster(N: integer);
  2375.   var  L: longint;
  2376.        z: integer;
  2377.  
  2378.       function  GetCluster : boolean;
  2379.       begin
  2380.     With CurrentField^ do
  2381.       If (typecode >= 'a') then
  2382.         GetCluster := (decimals = L)
  2383.        else
  2384.         GetCluster := odd(L shr decimals);
  2385.       end;
  2386.  
  2387.       procedure SetCluster(On: boolean);
  2388.       var  i : integer;
  2389.       begin
  2390.     With CurrentField^ do
  2391.       begin
  2392.       If (typecode >= 'a') then
  2393.         L := decimals
  2394.        else
  2395.         begin
  2396.         If On then
  2397.           L := L or (1 shl decimals)
  2398.          else
  2399.           L := pword(FieldData)^ and not (1 shl decimals);
  2400.         end;
  2401.       end;
  2402.       end;
  2403.  
  2404.   begin
  2405.     L := 0;
  2406.     If (sizeof(L) <= CurrentField^.fieldsize) then
  2407.       z := sizeof(L)
  2408.      else
  2409.       z := CurrentField^.fieldsize;
  2410.     Move(FieldData^, L, z);
  2411.     Case N of
  2412.        1:  SetCluster(TRUE);
  2413.       -1:  SetCluster(FALSE);
  2414.      else  SetCluster(not GetCluster);
  2415.       end;
  2416.     Move(L, FieldData^, z);
  2417.     ChangeMade;
  2418.     If (CurrentField^.typecode >= 'a') and (Owner <> nil) then
  2419.       DrawView
  2420.      else
  2421.       DrawField(CurrentField);
  2422.   end;
  2423.  
  2424.   function  HexByte(Number: byte) : string;
  2425.   const bts  : array[0..15] of char = '0123456789ABCDEF';
  2426.   begin
  2427.     HexByte := bts[(Number shr 4) and $0F] + bts[Number and $0F]
  2428.   end;
  2429.  
  2430.   function  EffectField(HEX: boolean;    Min,Max: longint) : boolean;
  2431.   var i,j    : integer;
  2432.       FirstChar : integer;
  2433.       b        : boolean;
  2434.       R        : real;
  2435.   begin
  2436.     b := FALSE;
  2437.     If not ((Event.CharCode in [^G,^H,'.','-','_','0'..'9']) or
  2438.        (HEX and (upcase(Event.CharCode) in ['A'..'F'])))
  2439.     or (CurrentField^.access and accReadOnly <> 0)
  2440.     or (Locked) or (not CheckRecLock)
  2441.      then
  2442.       begin
  2443.       WrongKeypressed(Event);
  2444.       end
  2445.      else
  2446.       If A <> '' then With CurrentField^ do
  2447.     begin
  2448.     If (upperlimit <> 0) and (Max > upperlimit) then Max := upperlimit;
  2449.     If (decimals > 0) then i := succ(truelen) else i := truelen;
  2450.     If not HEX and (length(A) > i) then
  2451.       begin
  2452.       A[0] := chr(i);
  2453.       fillchar(A[1], length(A), '0');
  2454.       If length(A) - decimals > 2 then
  2455.         fillchar(A[1], length(A) - decimals - 2, ' ');
  2456.       If decimals > 0 then A[length(A) - decimals] := '.';
  2457.       end;
  2458.     If typecode in ['A'..'Z'] then Min := 0;
  2459.     FirstChar := pos('.', A);
  2460.     If FirstChar > 0 then Dec(FirstChar) else FirstChar := length(A);
  2461.     If CurPos < pred(FirstChar) then CurPos := pred(FirstChar);
  2462.     Case Event.CharCode of
  2463.       ^G,
  2464.       ^H  :
  2465.           begin
  2466.           If CurPos = pred(FirstChar) then
  2467.         begin
  2468.         If (FirstChar < length(A)) then
  2469.           fillchar(A[FirstChar + 2], length(A) - succ(FirstChar), '0');
  2470.         If FirstChar > 1 then
  2471.           begin
  2472.           Move(A[1], A[2], pred(FirstChar));
  2473.           If HEX then A[1] := '0' else A[1] := ' ';
  2474.           If A[FirstChar] = '-' then
  2475.             begin
  2476.             A[FirstChar] := '0';
  2477.             ShowFmt := ShowFmt - [shownegative];
  2478.             end;
  2479.           end
  2480.          else
  2481.           begin
  2482.           A[1] := '0';
  2483.           end;
  2484.         end
  2485.            else
  2486.         begin
  2487.         A[succ(CurPos)] := '0';
  2488.         Dec(CurPos);
  2489.         If CurPos = FirstChar then Dec(CurPos);
  2490.         end;
  2491.           b := FALSE;
  2492.           For i := 1 to length(A) do If A[i] > '0' then b := TRUE;
  2493.           If not b then ShowFmt := ShowFmt - [shownegative];
  2494.           b := TRUE;
  2495.           If (A[FirstChar] = ' ') then A[FirstChar] := '0';
  2496.           end;
  2497.       '.' :
  2498.           begin
  2499.           If FirstChar < length(A) then
  2500.         begin
  2501.         CurPos := FirstChar;
  2502.         fillchar(A[FirstChar + 2], length(A) - succ(FirstChar), '0');
  2503.         b := TRUE;
  2504.         end
  2505.            else WrongKeypressed(Event);
  2506.           end;
  2507.       '-','_' :
  2508.           begin
  2509.           If (Min <> 0) and (A[1] = ' ') and
  2510.          (FirstChar > 1) and (pos('-', A) = 0) then
  2511.         begin
  2512.         i := pred(FirstChar);
  2513.         ShowFmt := ShowFmt + [shownegative];
  2514.         While (A[i] <> ' ') do Dec(i);
  2515.         A[i] := '-';
  2516.         b := TRUE;
  2517.         end
  2518.            else WrongKeypressed(Event);
  2519.           end;
  2520.      else begin
  2521.           If (shownegative in ShowFmt) and (pos('-',A) = 0) then
  2522.         begin
  2523.         If A[1] = ' ' then
  2524.           begin
  2525.           i := FirstChar;
  2526.           While (A[i] <> ' ') do Dec(i);
  2527.           If i <> 0 then A[i] := '-';
  2528.           end;
  2529.         end;
  2530.           If CurPos = pred(FirstChar) then
  2531.         begin
  2532.         If A[1] in [' ','0'] then
  2533.           begin
  2534.           If (FirstChar > 1) and not ((A[FirstChar] = '0') and (A[pred(FirstChar)] in ['-',' ']))
  2535.            then Move(A[2], A[1], pred(FirstChar));
  2536.           A[FirstChar] := Event.CharCode;
  2537.           b := TRUE;
  2538.           end;
  2539.         end
  2540.            else
  2541.         begin
  2542.         A[succ(CurPos) + 1] := Event.CharCode;
  2543.         If pred(length(A)) > CurPos then Inc(CurPos);
  2544.         b := TRUE;
  2545.         end;
  2546.           If (Max > 0) then
  2547.         begin
  2548.         Val(A, R, i);
  2549.         If (i <> 0) or (R > Max) or (R < Min) then b := FALSE;
  2550.         end
  2551.            else
  2552.         begin
  2553.         If (TC = fldCHARVAL) and parenthesis and (A[1] > '-') then b := FALSE;
  2554.         end;
  2555.           If not b then WrongKeypressed(Event);
  2556.           end;
  2557.       end;
  2558.     end;
  2559.     If b then
  2560.       begin
  2561.       ChangeMade;
  2562.       end;
  2563.     EffectField := b;
  2564.   end;
  2565.  
  2566.   procedure EditEnumField;
  2567.   var  i,j  : integer;
  2568.        Pick : PSItem;
  2569.        C    : char;
  2570.  
  2571.       function    MaxItems : integer;
  2572.       var  i     : integer;
  2573.        Items : PSItem;
  2574.       begin
  2575.     Items := PSItem(CurrentField^.template);
  2576.     i := 0;
  2577.     While (Items^.Next <> nil) do
  2578.       begin
  2579.       Items := Items^.Next;
  2580.       inc(i);
  2581.       end;
  2582.     MaxItems := i;
  2583.       end;
  2584.  
  2585.   begin
  2586.     If (CurrentField^.access and accReadOnly <> 0)
  2587.       or Locked or not CheckRecLock then
  2588.       begin
  2589.       WrongKeypressed(Event);
  2590.       end
  2591.      else
  2592.       begin
  2593.       Event.CharCode := upcase(Event.CharCode);
  2594.       Case Event.CharCode of
  2595.     ^M:   QuitField(cmDMX_Enter);
  2596.     'A'..'Z':
  2597.       begin
  2598.       Pick := PSItem(CurrentField^.template);
  2599.       j    := 0;
  2600.       While (Pick <> nil) do
  2601.         begin
  2602.         i :=  1;
  2603.         C := #0;
  2604.         While (Pick^.Value <> nil) and (i < length(Pick^.Value^)) and (C = #0) do
  2605.           begin
  2606.           If (Pick^.Value^[i] in ['A'..'Z']) then C := upcase(Pick^.Value^[i]);
  2607.           Inc(i);
  2608.           end;
  2609.         If (C = Event.CharCode) then
  2610.           begin
  2611.           pbyte(FieldData)^ := j;
  2612.           ChangeMade;
  2613.           Pick := nil;
  2614.           end
  2615.          else
  2616.           begin
  2617.           Inc(j);
  2618.           Pick := Pick^.Next;
  2619.           end;
  2620.         end;
  2621.       end;
  2622.     '+','*',' ':
  2623.       begin
  2624.       Inc(pbyte(FieldData)^);
  2625.       If (pbyte(FieldData)^ > MaxItems) then pbyte(FieldData)^ := 0;
  2626.       ChangeMade;
  2627.       end;
  2628.     ^G, ^H,'-':
  2629.       begin
  2630.       If (pbyte(FieldData)^ = 0) then
  2631.         pbyte(FieldData)^ := MaxItems else Dec(pbyte(FieldData)^);
  2632.       ChangeMade;
  2633.       end;
  2634.        else WrongKeypressed(Event);
  2635.     end;
  2636.       end;
  2637.   end;
  2638.  
  2639.   function  AnotherView(View: PView) : boolean;  far;
  2640.   begin
  2641.     AnotherView := (View^.Options and ofSelectable <> 0) and (View <> @Self);
  2642.   end;
  2643.  
  2644. begin
  2645.   If (DataBlockSize < RecordSize) or (RecordSize <= 0) then Exit;
  2646.   If (Event.KeyCode = kbTab) or (Event.KeyCode = kbShiftTab) then
  2647.     begin
  2648.     If (Owner^.FirstThat(@AnotherView) = nil) then
  2649.       begin
  2650.       If (Event.KeyCode = kbTab) then QuitField(cmDMX_Right) else QuitField(cmDMX_Left);
  2651.       end;
  2652.     Exit;
  2653.     end;
  2654.   If Locked or RecWasLocked or (CurrentField^.access and accReadOnly <> 0) then FirstKey := TRUE;
  2655.   InsOn        := not GetState(sfCursorIns);
  2656.   Go        := TRUE;
  2657.   If CurrentField = nil then CurrentField := DMXfield1;
  2658.   If (Event.What = evKeyDown) then
  2659.     begin
  2660.     If (Event.KeyCode = kbShiftEnter) then Exit;
  2661.     If (Event.KeyCode = kbShiftIns) then Event.CharCode := '0';
  2662.     If (Event.KeyCode = kbShiftDel) then Event.CharCode := '.';
  2663.     With CurrentField^ do
  2664.       begin
  2665.       TC := upcase(typecode);
  2666.       If (Event.KeyCode = kbEsc) or (Event.KeyCode = kbEnter) then
  2667.     begin
  2668.     QuitField(cmDMX_Enter);
  2669.     end
  2670.        else
  2671.     begin
  2672.     Event.KeyCode := CtrlToArrow(Event.KeyCode);
  2673.     If (FirstKey and InsOn) or
  2674.        (Locked or (CurrentField^.access and accReadOnly <> 0)) then
  2675.       begin
  2676.       If Event.KeyCode = kbRight then Event.KeyCode := kbCtrlRight
  2677.       else
  2678.       If Event.KeyCode = kbLeft  then Event.KeyCode := kbCtrlLeft;
  2679.       end
  2680.      else
  2681.       If (TC in [fldSTR,fldSTRNUM,fldCHAR,fldCHARNUM]) then
  2682.         begin
  2683.         If Event.KeyCode = kbRight then Event.CharCode := ^D else
  2684.         If Event.KeyCode = kbLeft  then Event.CharCode := ^S;
  2685.         end;
  2686.     If (Event.KeyCode = kbDel) then Event.CharCode := ^G;
  2687.     If (Event.CharCode <> #0) then
  2688.       begin
  2689.       If FirstKey
  2690.         and (upcase(Event.CharCode) in ['-','.','0'..'9','A'..'F'])
  2691.         and (access and accReadOnly = 0)
  2692.        then
  2693.         begin
  2694.         If (TC in [fldBYTE, fldSHORTINT, fldWORD, fldINTEGER,
  2695.                fldLONGINT, fldCHARVAL, fldREALNUM, fldHEXVALUE])
  2696.          then ZeroizeField(FALSE, CurrentField);
  2697.         end;
  2698.       Case TC of
  2699.         fldSTR,
  2700.         fldSTRNUM,
  2701.         fldCHAR,
  2702.         fldCHARNUM:
  2703.           begin
  2704.           If typecode < 'a' then Event.CharCode := upcase(Event.CharCode);
  2705.           If ((TC in [fldSTRNUM, fldCHARNUM]) and
  2706.          not (Event.CharCode in [#0..'9'])) or Locked
  2707.           or (access and accReadOnly <> 0)
  2708.           or not CheckRecLock then
  2709.         begin
  2710.         WrongKeypressed(Event);
  2711.         Go  := FALSE;
  2712.         end
  2713.            else
  2714.         begin
  2715.         If TC in [fldSTR, fldSTRNUM] then inx := 1 else inx := 0;
  2716.         Case Event.CharCode of
  2717.           ^G,    { kbDel }
  2718.           ^H:    { kbBack }
  2719.             begin
  2720.             If Event.CharCode = ^H then
  2721.               begin
  2722.               If CurPos = 0 then Go := FALSE else Dec(CurPos);
  2723.               end;
  2724.             If Go then
  2725.               begin
  2726.               If (inx > 0) and (length(pstring(FieldData)^) <= CurPos) then Go := FALSE;
  2727.               If Go then
  2728.             begin
  2729.             ChangeMade;
  2730.             If (fieldsize - CurPos - inx > 1) then
  2731.               Move(pstring(FieldData)^[CurPos + inx + 1],
  2732.                 pstring(FieldData)^[CurPos + inx], fieldsize - CurPos - inx - 1);
  2733.             pstring(FieldData)^[pred(fieldsize)] := fillvalue;
  2734.             If (inx <> 0) and (pbyte(FieldData)^ > 0) then Dec(pstring(FieldData)^[0]);
  2735.             end;
  2736.               end;
  2737.             end;
  2738.           ^D:    { kbRight }
  2739.             If CurPos < fieldsize - inx - 1 then Inc(CurPos) else QuitField(cmDMX_Right);
  2740.           ^S:    { kbLeft }
  2741.             begin
  2742.             If (CurPos > 0) then Dec(CurPos) else QuitField(cmDMX_Left);
  2743.             end;
  2744.           ^A..^Z:  { prevent ctrl-characters from being entered }
  2745.             begin
  2746.             end;
  2747.            else begin
  2748.             If inx = 0 then i := fieldsize else i := pbyte(FieldData)^;
  2749.             If InsOn then
  2750.               begin
  2751.               If (fieldsize = succ(inx)) then pstring(FieldData)^[inx] := fillvalue;
  2752.               If (ord(pstring(FieldData)^[pred(fieldsize)]) and $DF = 0)
  2753.               or
  2754.              ((inx = 1) and (length(pstring(FieldData)^) < pred(fieldsize)))
  2755.                then
  2756.             begin
  2757.             ChangeMade;
  2758.             If (inx <> 0) then
  2759.               begin
  2760.               If (CurPos > i) then
  2761.                 begin
  2762.                 fillchar(pstring(FieldData)^[succ(i)], CurPos-i, fillvalue);
  2763.                 pbyte(FieldData)^ := succ(CurPos);
  2764.                 end
  2765.                else
  2766.                 Inc(pbyte(FieldData)^);
  2767.               end;
  2768.             If succ(CurPos) + inx < fieldsize then
  2769.               Move(pstring(FieldData)^[CurPos + inx],
  2770.                 pstring(FieldData)^[CurPos + inx + 1],
  2771.                 fieldsize - CurPos - inx - 1);
  2772.             pstring(FieldData)^[CurPos + inx] := Event.CharCode;
  2773.             end
  2774.                else
  2775.             begin
  2776.             WrongKeypressed(Event);
  2777.             Go := FALSE;
  2778.             end;
  2779.               end
  2780.              else
  2781.               begin
  2782.               ChangeMade;
  2783.               If (inx <> 0) and (CurPos >= i) then
  2784.             begin
  2785.             fillchar(pstring(FieldData)^[succ(i)],
  2786.                   CurPos - i, fillvalue);
  2787.             pbyte(FieldData)^ := succ(CurPos);
  2788.             end;
  2789.               pstring(FieldData)^[CurPos + inx] := Event.CharCode;
  2790.               end;
  2791.             If CurPos < fieldsize - inx - 1 then
  2792.               begin
  2793.               If Go then Inc(CurPos);
  2794.               end
  2795.              else QuitField(cmDMX_Right);
  2796.             end;
  2797.           end;    { case of CharCode }
  2798.         If (CurPos < FirstPos) then FirstPos := CurPos;
  2799.         end;
  2800.           end;
  2801.  
  2802.         fldCHARVAL:
  2803.           begin
  2804.           Move(FieldData^, A[1], fieldsize);
  2805.           A[0] := chr(fieldsize);
  2806.           j := 0;
  2807.           For i := 1 to fieldsize do
  2808.         begin
  2809.         If (ord(A[i]) and not $20 = 0) then A[i] := ' ' else
  2810.         If (A[i] in ['-', '.', '0'..'9']) then j := 1;
  2811.         end;
  2812.           If j = 0 then
  2813.         begin
  2814.         fillchar(A[1], fieldsize, '0');
  2815.         If fieldsize - decimals > 2 then fillchar(A[1], fieldsize - decimals - 2, ' ');
  2816.         If decimals > 0 then A[fieldsize - decimals] := '.';
  2817.         end;
  2818.           If EffectField(FALSE, -1, 0) then
  2819.         begin
  2820.         i := 1;
  2821.         While (i < length(A)) and (A[i] <= '.') do
  2822.           begin
  2823.           If (A[succ(i)] <> '.') then A[i] := CurrentField^.fillvalue;
  2824.           Inc(i);
  2825.           end;
  2826.         Move(A[1], FieldData^, fieldsize);
  2827.         end;
  2828.           end;
  2829.  
  2830.         fldBYTE:
  2831.           begin
  2832.           Str(pbyte(FieldData)^:truelen, A);
  2833.           If EffectField(FALSE, 0,255) then Val(A,pbyte(FieldData)^,i);
  2834.           end;
  2835.  
  2836.         fldSHORTINT:
  2837.           begin
  2838.           Str(pshortint(FieldData)^:truelen, A);
  2839.           If EffectField(FALSE, -128,127) then Val(A,pshortint(FieldData)^,i);
  2840.           end;
  2841.  
  2842.         fldWORD:
  2843.           begin
  2844.           Str(pword(FieldData)^:truelen, A);
  2845.           If EffectField(FALSE, 0,65535) then Val(A,pword(FieldData)^,i);
  2846.           end;
  2847.  
  2848.         fldINTEGER:
  2849.           begin
  2850.           Str(pinteger(FieldData)^:truelen, A);
  2851.           If EffectField(FALSE, -1 - MaxInt, MaxInt) then Val(A,pinteger(FieldData)^,i);
  2852.           end;
  2853.  
  2854.         fldLONGINT:
  2855.           begin
  2856.           Str(plongint(FieldData)^:truelen, A);
  2857.           If EffectField(FALSE, -1 - MaxLongInt, MaxLongInt) then
  2858.         Val(A,plongint(FieldData)^,i);
  2859.           end;
  2860.  
  2861.         fldREALNUM:
  2862.           begin
  2863.           If decimals > 0 then i := 1 else i := 0;
  2864.           Str(prealnum(FieldData)^:truelen + i:decimals, A);
  2865.           If EffectField(FALSE, -1, 0) then Val(A,prealnum(FieldData)^,i);
  2866.           end;
  2867.  
  2868.         fldENUM:
  2869.           begin
  2870.           EditEnumField;
  2871.           end;
  2872.  
  2873.         fldBOOLEAN:
  2874.           begin
  2875.           If (access and accReadOnly <> 0) or Locked or not CheckRecLock then
  2876.         begin
  2877.         WrongKeypressed(Event);
  2878.         end
  2879.            else
  2880.         begin
  2881.         Event.CharCode := upcase(Event.CharCode);
  2882.         If (Event.CharCode >= '_') then
  2883.           begin
  2884.           If pboolean(FieldData)^ then Event.CharCode := ^G
  2885.           end
  2886.         else
  2887.         If (Event.CharCode >= ' ') then
  2888.           begin
  2889.           If pboolean(FieldData)^ then
  2890.             Event.CharCode := '-' else Event.CharCode := '+';
  2891.           end;
  2892.         Case Event.CharCode of
  2893.           '_',
  2894.           '+':    SetBoolean(TRUE);
  2895.           ^G,^H,
  2896.           '-':    SetBoolean(FALSE);
  2897.          else    WrongKeypressed(Event);
  2898.           end;
  2899.         end;
  2900.           end;
  2901.  
  2902.         fldCLUSTER:
  2903.           begin
  2904.           If (access and accReadOnly <> 0) or Locked or not CheckRecLock then
  2905.         begin
  2906.         WrongKeypressed(Event);
  2907.         end
  2908.            else
  2909.         begin
  2910.         Event.CharCode := upcase(Event.CharCode);
  2911.         Case Event.CharCode of
  2912.           '+':    ToggleCluster(1);
  2913.           ^G,^H,
  2914.           '-':    ToggleCluster(-1);
  2915.          else    ToggleCluster(0);
  2916.           end;
  2917.         end;
  2918.           end;
  2919.  
  2920.         fldHEXVALUE:
  2921.           begin
  2922.           Event.CharCode := upcase(Event.CharCode);
  2923.           If Event.CharCode in [^G,^H, '0'..'9', 'A'..'F'] then
  2924.         begin
  2925.         A  := '';
  2926.         For i := 1 to fieldsize do A := hexbyte(ord(pstring(FieldData)^[pred(i)])) + A;
  2927.         If (length(A) > truelen) then Delete(A, 1,1);
  2928.         If EffectField(TRUE, 0, 0) then
  2929.           begin
  2930.           If odd(length(A)) then A[0] := '0' else Move(A[1], A[0], length(A));
  2931.           For i := 0 to pred(fieldsize) do
  2932.             begin
  2933.             j := ord(A[i shl 1]);
  2934.             k := ord(A[succ(i shl 1)]);
  2935.             If j > ord('9') then Dec(j, 7);
  2936.             If k > ord('9') then Dec(k, 7);
  2937.             pstring(FieldData)^[pred(fieldsize) - i] := chr(((j and 15) shl 4) or (k and 15));
  2938.             end;
  2939.           end;
  2940.         end
  2941.            else
  2942.         WrongKeypressed(Event);
  2943.           end;
  2944.         end;
  2945.       end;
  2946.     If Event.What <> evNothing then FirstKey := FALSE;
  2947.     end;
  2948.       end;
  2949.     end;
  2950.   If (Event.What = evKeyDown) and (Event.CharCode <> #0) then
  2951.     begin
  2952.     DrawField(CurrentField);
  2953.     ClearEvent(Event);
  2954.     end
  2955.    else
  2956.     begin
  2957.     Go := TRUE;
  2958.     Case Event.ScanCode of
  2959.       hi(kbIns):    If InsOn then BlockCursor else NormalCursor;
  2960.       hi(kbCtrlEnd):    QuitField(cmDMX_ScreenBottom);
  2961.       hi(kbCtrlHome):    QuitField(cmDMX_ScreenTop);
  2962.       hi(kbCtrlLeft),
  2963.       hi(kbLeft):    QuitField(cmDMX_Left);
  2964.       hi(kbShiftTab):
  2965.       begin
  2966.       TScroller.HandleEvent(Event);
  2967.       If GetState(sfFocused) then QuitField(cmDMX_Left) else QuitField(cmDMX_Enter);
  2968.       end;
  2969.       hi(kbCtrlPgDn):    QuitField(cmDMX_Bottom);
  2970.       hi(kbCtrlPgUp):    QuitField(cmDMX_Top);
  2971.       hi(kbCtrlRight),
  2972.       hi(kbRight):    QuitField(cmDMX_Right);
  2973.       hi(kbEnd):    QuitField(cmDMX_End);
  2974.       hi(kbHome):    QuitField(cmDMX_Home);
  2975.       hi(kbPgDn):    QuitField(cmDMX_PgDn);
  2976.       hi(kbPgUp):    QuitField(cmDMX_PgUp);
  2977.       hi(kbUp):        QuitField(cmDMX_Up);
  2978.       hi(kbDown):    QuitField(cmDMX_Down);
  2979.      else        Go := FALSE;
  2980.       end;
  2981.     If Go then ClearEvent(Event);
  2982.     end;
  2983. end;
  2984.  
  2985.  
  2986. procedure TDmxEditor.ProcessMouse(var Event: TEvent);
  2987. var  i,j    : word;
  2988.      X        : boolean;
  2989.      MousePlace    : TPoint;
  2990.      E        : TEvent;
  2991. begin
  2992.   With Event do
  2993.     If (What = evMouseDown) and MouseInView(Where) then
  2994.       begin
  2995.       X  := TRUE;
  2996.       If (State and sfFocused = 0) then
  2997.     begin
  2998.     If (Options and (ofFirstClick or ofSelectable) = ofSelectable) or
  2999.        (State and sfActive = 0) then
  3000.       Exit;
  3001.     Select;
  3002.     X := FALSE;
  3003.     If (State and sfFocused = 0) then Exit;
  3004.     end;
  3005.       MakeLocal(Where, MousePlace);
  3006.       MousePlace.X := MousePlace.X + Delta.X;
  3007.       MousePlace.Y := MousePlace.Y + Delta.Y;
  3008.       Message(@Self, evCommand, cmDMX_goto, pointer(MousePlace));
  3009.       If X then
  3010.     begin
  3011.     If DoubleValid then
  3012.       begin
  3013.       If (CurrentField <> nil) and
  3014.          (upcase(CurrentField^.typecode) = fldCLUSTER)
  3015.        then
  3016.         Message(@Self, evKeyDown, $2020, @Self);
  3017.       If Double then
  3018.         begin
  3019.         With E do
  3020.           begin
  3021.           What := evCommand;
  3022.           Command := cmDMX_DoubleClick;
  3023.           InfoPtr := @Self;
  3024.           end;
  3025.         PutEvent(E);
  3026.         end;
  3027.       end;
  3028.     {else
  3029.       WrongKeypressed(Event); }
  3030.     end;
  3031.       If (Options and ofFirstClick = 0) or not DoubleValid then ClearEvent(Event);
  3032.       end;
  3033. end;
  3034.  
  3035.  
  3036. procedure TDmxEditor.ResetRecLock;
  3037. begin
  3038. end;
  3039.  
  3040.  
  3041. procedure TDmxEditor.ScrollDraw;
  3042. var  RS,FS: boolean;
  3043. begin
  3044.   FS := FieldSelected;
  3045.   RS := RecordSelected;
  3046.   If (VScrollBar <> nil) and (VScrollBar^.Value <> Delta.Y) then
  3047.     begin
  3048.     If not Valid(cmDMX_Up) then
  3049.       begin
  3050.       RS := FALSE;
  3051.       VScrollBar^.Value := Delta.Y;
  3052.       VScrollBar^.DrawView;
  3053.       end;
  3054.     If FS then EvaluateField;
  3055.     If RS then EvaluateRecord;
  3056.     end
  3057.    else
  3058.     RS := FALSE;
  3059.   TDmxScroller.ScrollDraw;
  3060.   If RS then
  3061.     begin
  3062.     If (CurrentRecord >= Delta.Y + Size.Y) then CurrentRecord := Delta.Y + pred(Size.Y)
  3063.     else
  3064.     If (CurrentRecord < Delta.Y) then CurrentRecord := Delta.Y;
  3065.     SetupRecord;
  3066.     If FS then SetupField;
  3067.     end;
  3068. end;
  3069.  
  3070.  
  3071. function  TDmxEditor.SetRecLock : boolean;
  3072. begin
  3073.   SetRecLock := TRUE;
  3074. end;
  3075.  
  3076.  
  3077. procedure TDmxEditor.SetState(AState: word; Enable: boolean);
  3078.  
  3079.     procedure HoldState(On,F: boolean);
  3080.     begin
  3081.       If On then
  3082.     begin
  3083.     JustAltered := FALSE;
  3084.     { verify CurrentRecord within valid range and select record/field }
  3085.     If not RecordSelected then
  3086.       begin
  3087.       If (DataBlockSize > 0) and (RecordSize > 0) and
  3088.          (DataBlockSize div RecordSize < CurrentRecord)
  3089.        then CurrentRecord := DataBlockSize div RecordSize;
  3090.       RedrawRecord := TRUE;
  3091.       Draw;
  3092.       SetUpRecord;
  3093.       end;
  3094.     If F and not FieldSelected then SetUpField;
  3095.     TDmxScroller.SetState(AState, Enable);
  3096.     end
  3097.        else
  3098.     begin
  3099.     TDmxScroller.SetState(AState, Enable);
  3100.     { deselect record/field and redisplay other windows }
  3101.     If FieldSelected then EvaluateField;
  3102.     If RecordSelected then EvaluateRecord;
  3103.     Message(DeskTop, evBroadcast, cmDMX_Draw, @Self);
  3104.     end;
  3105.     end;
  3106.  
  3107. begin
  3108.   If not Vidis or not RecordSelected then
  3109.     begin
  3110.     If (AState and sfActive <> 0) then
  3111.       begin
  3112.       HoldState(Enable, ((AState or State) and sfSelected <> 0));
  3113.       Exit;
  3114.       end
  3115.     else
  3116.     If RecordSelected and (AState and sfSelected <> 0) then
  3117.       begin
  3118.       If Enable and not FieldSelected then SetupField
  3119.       else
  3120.       If not Enable and FieldSelected then EvaluateField;
  3121.       end;
  3122.     end;
  3123.   If (AState and sfDragging <> 0) and (RecordSelected = Enable) then
  3124.     HoldState(not Enable, (State and sfSelected <> 0))
  3125.   else
  3126.   TDmxScroller.SetState(AState, Enable);
  3127. end;
  3128.  
  3129.  
  3130. procedure TDmxEditor.SetUpField;
  3131. begin
  3132.   RedrawRecord    := TRUE;
  3133.   FieldSelected := TRUE;
  3134.   FieldAltered    := FALSE;
  3135.   FieldData := ptr(seg(RecordData^), ofs(RecordData^) + CurrentField^.datatab);
  3136.   FirstKey  := TRUE;
  3137.   If (showCurrentField in ShowFmt) then
  3138.     ShowFmt := [showanyway, showCurrentField]
  3139.    else
  3140.     ShowFmt := [showanyway];
  3141.   CurPos   :=    0;
  3142.   FirstPos :=    0;
  3143.   With CurrentField^ do
  3144.     If upcase(typecode) in [fldCHARVAL, fldBYTE, fldSHORTINT, fldWORD,
  3145.                 fldINTEGER, fldLONGINT, fldREALNUM, fldHEXVALUE]
  3146.      then
  3147.       begin
  3148.       CurPos := pred(truelen - decimals);
  3149.       If CurPos < 0 then CurPos := 0;
  3150.       end
  3151.      else
  3152.       If (upcase(typecode) = fldENUM) then CurPos := -1;
  3153.   If (State and sfVisible <> 0) then DrawField(CurrentField);
  3154.   If (RecInd <> nil) then RecInd^.DrawView;
  3155. end;
  3156.  
  3157.  
  3158. procedure TDmxEditor.SetUpRecord;
  3159. var  F : pDMXfieldrec;
  3160. begin
  3161.   F := DMXfield1;
  3162.   ActualRecordNum := CurrentRecord;
  3163.   ActualRecordNum := BaseRecord + ActualRecordNum;
  3164.   RecordData     := DataAt(CurrentRecord);
  3165.   RecordAltered     := FALSE;
  3166.   FieldAltered     := FALSE;
  3167.   RecordSelected := TRUE;
  3168.   ClearRecLock;
  3169.   Message(Owner, evBroadcast, cmDMX_SetupRecord, @Self);
  3170.   If (showCurrentField in ShowFmt) and (CurrentField <> nil) and (DMXfield1 = F) then
  3171.     begin
  3172.     FieldData := ptr(seg(RecordData^), ofs(RecordData^) + CurrentField^.datatab);
  3173.     DrawField(CurrentField);
  3174.     end;
  3175. end;
  3176.  
  3177.  
  3178. function  TDmxEditor.Valid(Command: word) : boolean;
  3179.     function RO : boolean;
  3180.     var  field : pDMXfieldrec;
  3181.     begin
  3182.       If (Command = cmDMX_ZeroizeField) then
  3183.     RO := (CurrentField = nil) or (CurrentField^.access and accReadOnly <> 0)
  3184.        else
  3185.     begin
  3186.     RO := FALSE;
  3187.     field := DMXfield1;
  3188.     While (field <> nil) do
  3189.       begin
  3190.       If (field^.access and accReadOnly <> 0) then RO := TRUE;
  3191.       field := field^.Next;
  3192.       end;
  3193.     end;
  3194.     end;
  3195. begin
  3196.   If ((Command = cmDMX_ZeroizeRecord) or (Command = cmDMX_ZeroizeField))
  3197.      and (Locked or RO)
  3198.    then
  3199.     Valid := FALSE
  3200.    else
  3201.     Valid := TDmxScroller.Valid(Command);
  3202. end;
  3203.  
  3204. const ClearingRec : boolean = FALSE;
  3205.  
  3206. procedure TDmxEditor.ZeroizeField(Whole: boolean;  Field: pDMXfieldrec);
  3207. var  FData : pointer;
  3208.      fn    : integer;
  3209.      cltr  : boolean;
  3210. begin
  3211.   If (RecordData = nil) or (Field = nil) or Locked then Exit;
  3212.   If CheckRecLock then
  3213.     begin
  3214.     cltr := FALSE;
  3215.     fn := Field^.fieldnum;
  3216.     If Whole and (fn <> 0) then Field := DMXfield1;
  3217.     While Field <> nil do
  3218.       begin
  3219.       If Field^.fieldnum = fn then
  3220.     begin
  3221.     With Field^ do
  3222.       If (access and accReadOnly = 0) and (fieldsize > 0) then
  3223.         begin
  3224.         FData := ptr(seg(RecordData^), ofs(RecordData^) + datatab);
  3225.         If (Field^.typecode <> fldCLUSTER) then fillchar(FData^, fieldsize, fillvalue);
  3226.         Case upcase(typecode) of
  3227.           fldSTR,
  3228.           fldSTRNUM:    pstring(FData)^[0] := #0;
  3229.           fldCHARVAL:
  3230.         begin
  3231.         fillchar(FData^, fieldsize, '0');
  3232.         If fieldsize - decimals > 2 then fillchar(FData^, fieldsize - decimals - 2, ' ');
  3233.         If decimals > 0 then pstring(FData)^[fieldsize - decimals - 1] := '.';
  3234.         end;
  3235.           fldCLUSTER:
  3236.         begin
  3237.         If (Field^.typecode = fldCLUSTER) then
  3238.           word(FData^) := word(FData^) and not (1 shl Field^.decimals);
  3239.         cltr := TRUE;
  3240.         end;
  3241.           end;
  3242.         ChangeMade;
  3243.         end;
  3244.     end;
  3245.       If Whole and (fn <> 0) then Field := Field^.Next else Field := nil;
  3246.       end;
  3247.     FirstKey := TRUE;
  3248.     If Cltr then
  3249.       begin
  3250.       If not ClearingRec then DrawView;
  3251.       ClearingRec := FALSE;
  3252.       end;
  3253.     RedrawRecord := TRUE;
  3254.     end;
  3255. end;
  3256.  
  3257.  
  3258. procedure TDmxEditor.ZeroizeRecord;
  3259. var  field : pDMXfieldrec;
  3260. begin
  3261.   If CheckRecLock then
  3262.     begin
  3263.     ClearingRec := TRUE;
  3264.     field := DMXfield1;
  3265.     If (RecordData <> nil) then
  3266.       While (field <> nil) do
  3267.     begin
  3268.     ZeroizeField(FALSE, field);
  3269.     field := field^.Next;
  3270.     end;
  3271.     If not ClearingRec then DrawView;
  3272.     ClearingRec := FALSE;
  3273.     end;
  3274. end;
  3275.  
  3276.  
  3277.   { ══════════════════════════════════════════════════════════════════════ }
  3278.  
  3279.  
  3280. procedure RegisterTVDMX;
  3281. begin
  3282.   RegisterType(RDmxExtLabels);
  3283.   RegisterType(RDmxLabels);
  3284.   RegisterType(RDmxFLabels);
  3285.   RegisterType(RDmxMLabels);
  3286.   RegisterType(RDmxRecInd);
  3287.   RegisterType(RDmxScroller);
  3288.   RegisterType(RDmxEditor);
  3289. end;
  3290.  
  3291.  
  3292.   { ══════════════════════════════════════════════════════════════════════ }
  3293.  
  3294.  
  3295. End.
  3296.